home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / bind.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  75.7 KB  |  2,531 lines  |  [TEXT/ALFA]

  1. # This file is a Tcl script to test out Tk's "bind" and "bindtags"
  2. # commands plus the procedures in tkBind.c.  It is organized in the
  3. # standard fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1994 The Regents of the University of California.
  6. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  7. #
  8. # See the file "license.terms" for information on usage and redistribution
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10. #
  11. # SCCS: @(#) bind.test 1.39 97/07/01 18:01:05
  12.  
  13. if {[string compare test [info procs test]] != 0} {
  14.     source defs
  15. }
  16.  
  17. catch {destroy .b}
  18. toplevel .b -width 100 -height 50
  19. wm geom .b +0+0
  20. update idletasks
  21.  
  22. proc setup {} {
  23.     catch {destroy .b.f}
  24.     frame .b.f -class Test -width 150 -height 100
  25.     pack .b.f
  26.     focus -force .b.f
  27.     foreach p [event info] {event delete $p}    
  28.     update
  29. }
  30. setup
  31.  
  32. foreach i [bind Test] {
  33.     bind Test $i {}
  34. }
  35. foreach i [bind all] {
  36.     bind all $i {}
  37. }
  38.  
  39. test bind-1.1 {bind command} {
  40.     list [catch {bind} msg] $msg
  41. } {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
  42. test bind-1.2 {bind command} {
  43.     list [catch {bind a b c d} msg] $msg
  44. } {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
  45. test bind-1.3 {bind command} {
  46.     list [catch {bind .gorp} msg] $msg
  47. } {1 {bad window path name ".gorp"}}
  48. test bind-1.4 {bind command} {
  49.     list [catch {bind foo} msg] $msg
  50. } {0 {}}
  51. test bind-1.5 {bind command} {
  52.     list [catch {bind .b <gorp-> {}} msg] $msg
  53. } {0 {}}
  54. test bind-1.6 {bind command} {
  55.     catch {destroy .b.f}
  56.     frame .b.f
  57.     bind .b.f <Enter> {test script}
  58.     set result [bind .b.f <Enter>]
  59.     bind .b.f <Enter> {}
  60.     list $result [bind .b.f <Enter>]
  61. } {{test script} {}}
  62. test bind-1.7 {bind command} {
  63.     catch {destroy .b.f}
  64.     frame .b.f
  65.     bind .b.f <Enter> {test script}
  66.     bind .b.f <Enter> {+more text}
  67.     bind .b.f <Enter>
  68. } {test script
  69. more text}
  70. test bind-1.8 {bind command} {
  71.     list [catch {bind .b <gorp-> {test script}} msg] $msg [bind .b]
  72. } {1 {bad event type or keysym "gorp"} {}}
  73. test bind-1.9 {bind command} {
  74.     list [catch {bind .b <gorp->} msg] $msg
  75. } {0 {}}
  76. test bind-1.10 {bind command} {
  77.     catch {destroy .b.f}
  78.     frame .b.f
  79.     bind .b.f <Enter> {script 1}
  80.     bind .b.f <Leave> {script 2}
  81.     bind .b.f a {script for a}
  82.     bind .b.f b {script for b}
  83.     lsort [bind .b.f]
  84. } {<Enter> <Leave> a b}
  85.  
  86. test bind-2.1 {bindtags command} {
  87.     list [catch {bindtags} msg] $msg
  88. } {1 {wrong # args: should be "bindtags window ?tags?"}}
  89. test bind-2.2 {bindtags command} {
  90.     list [catch {bindtags a b c} msg] $msg
  91. } {1 {wrong # args: should be "bindtags window ?tags?"}}
  92. test bind-2.3 {bindtags command} {
  93.     list [catch {bindtags .foo} msg] $msg
  94. } {1 {bad window path name ".foo"}}
  95. test bind-2.4 {bindtags command} {
  96.     bindtags .b
  97. } {.b Toplevel all}
  98. test bind-2.5 {bindtags command} {
  99.     catch {destroy .b.f}
  100.     frame .b.f
  101.     bindtags .b.f
  102. } {.b.f Frame .b all}
  103. test bind-2.6 {bindtags command} {
  104.     catch {destroy .b.f}
  105.     frame .b.f
  106.     bindtags .b.f {{x y z} b c d}
  107.     bindtags .b.f
  108. } {{x y z} b c d}
  109. test bind-2.7 {bindtags command} {
  110.     catch {destroy .b.f}
  111.     frame .b.f
  112.     bindtags .b.f {x y z}
  113.     bindtags .b.f {}
  114.     bindtags .b.f
  115. } {.b.f Frame .b all}
  116. test bind-2.8 {bindtags command} {
  117.     catch {destroy .b.f}
  118.     frame .b.f
  119.     bindtags .b.f {x y z}
  120.     bindtags .b.f {a b c d}
  121.     bindtags .b.f
  122. } {a b c d}
  123. test bind-2.9 {bindtags command} {
  124.     catch {destroy .b.f}
  125.     frame .b.f
  126.     bindtags .b.f {a b c}
  127.     list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f]
  128. } {1 {unmatched open brace in list} {.b.f Frame .b all}}
  129. test bind-2.10 {bindtags command} {
  130.     catch {destroy .b.f}
  131.     frame .b.f
  132.     bindtags .b.f {a b c}
  133.     list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f]
  134. } {0 {} {a .gorp b}}
  135. test bind-3.1 {TkFreeBindingTags procedure} {
  136.     catch {destroy .b.f}
  137.     frame .b.f
  138.     bindtags .b.f "a b c d"
  139.     destroy .b.f
  140. } {}
  141. test bind-3.2 {TkFreeBindingTags procedure} {
  142.     catch {destroy .b.f}
  143.     frame .b.f
  144.     catch {bindtags .b.f "a .gorp b .b.f"}
  145.     destroy .b.f
  146. } {}
  147.  
  148. bind all <Enter> {lappend x "%W enter all"}
  149. bind Test <Enter> {lappend x "%W enter frame"}
  150. bind Toplevel <Enter> {lappend x "%W enter toplevel"}
  151. bind xyz <Enter> {lappend x "%W enter xyz"}
  152. bind {a b} <Enter> {lappend x "%W enter {a b}"}
  153. bind .b <Enter>  {lappend x "%W enter .b"}
  154. test bind-4.1 {TkBindEventProc procedure} {
  155.     catch {destroy .b.f}
  156.     frame .b.f -class Test -width 150 -height 100
  157.     pack .b.f
  158.     update
  159.     bind .b.f <Enter> {lappend x "%W enter .b.f"}
  160.     set x {}
  161.     event gen .b.f <Enter>
  162.     set x
  163. } {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}}
  164. test bind-4.2 {TkBindEventProc procedure} {
  165.     catch {destroy .b.f}
  166.     frame .b.f -class Test -width 150 -height 100
  167.     pack .b.f
  168.     update
  169.     bind .b.f <Enter> {lappend x "%W enter .b.f"}
  170.     bindtags .b.f {.b.f {a b} xyz}
  171.     set x {}
  172.     event gen .b.f <Enter> 
  173.     set x
  174. } {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}}
  175. test bind-4.3 {TkBindEventProc procedure} {
  176.     set x {}
  177.     event gen .b <Enter>
  178.     set x
  179. } {{.b enter .b} {.b enter toplevel} {.b enter all}}
  180. test bind-4.4 {TkBindEventProc procedure} {
  181.     catch {destroy .b.f}
  182.     frame .b.f -class Test -width 150 -height 100
  183.     pack .b.f
  184.     update
  185.     bindtags .b.f {.b.f .b.f2 .b.f3}
  186.     frame .b.f3 -width 50 -height 50
  187.     pack .b.f3
  188.     bind .b.f <Enter> {lappend x "%W enter .b.f"}
  189.     bind .b.f3 <Enter> {lappend x "%W enter .b.f3"}
  190.     set x {}
  191.     event gen .b.f <Enter>
  192.     destroy .b.f3
  193.     set x
  194. } {{.b.f enter .b.f} {.b.f enter .b.f3}}
  195. test bind-4.5 {TkBindEventProc procedure} {
  196.     # This tests memory allocation for objPtr;  it won't serve any useful
  197.     # purpose unless run with some sort of allocation checker turned on.
  198.     catch {destroy .b.f}
  199.     frame .b.f -class Test -width 150 -height 100
  200.     pack .b.f
  201.     update
  202.     bindtags .b.f {a b c d e f g h i j k l m n o p q r s t u v w x y z}
  203.     event gen .b.f <Enter>
  204. } {}
  205. bind all <Enter> {}
  206. bind Test <Enter> {}
  207. bind Toplevel <Enter> {}
  208. bind xyz <Enter> {}
  209. bind {a b} <Enter> {}
  210. bind .b <Enter> {}
  211.  
  212. test bind-5.1 {Tk_CreateBindingTable procedure} {
  213.     catch {destroy .b.c}
  214.     canvas .b.c
  215.     .b.c bind foo
  216. } {}
  217.  
  218.  
  219. test bind-6.1 {Tk_DeleteBindTable procedure} {
  220.     catch {destroy .b.c}
  221.     canvas .b.c
  222.     .b.c bind foo <1> {string 1}
  223.     .b.c create rectangle 0 0 100 100
  224.     .b.c bind 1 <2> {string 2}
  225.     destroy .b.c
  226. } {}
  227. test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} {
  228.     catch {interp delete foo}
  229.     interp create foo
  230.     foo eval {
  231.     load {} Tk
  232.     load {} Tktest
  233.     wm geometry . +0+0
  234.     frame .t -width 50 -height 50
  235.     bindtags .t {a b c d}
  236.     pack .t
  237.     update
  238.     set x {}
  239.     testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1"
  240.     bind b <1> "lappend x b1"
  241.     testcbind c <1> "lappend x c1" "lappend x bye.c1"
  242.     testcbind c <2> "lappend x all2" "lappend x bye.all2"
  243.     event gen .t <1>
  244.     }
  245.     set x [foo eval set x]
  246.     interp delete foo
  247.     set x
  248. } {a1 bye.all2 bye.a1 b1 bye.c1}
  249.  
  250. test bind-7.1 {Tk_CreateBinding procedure: error} {
  251.     catch {destroy .b.c}
  252.     canvas .b.c
  253.     list [catch {.b.c bind foo <} msg] $msg
  254. } {1 {no event type or button # or keysym}}
  255. test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} {
  256.     catch {destroy .b.f}
  257.     frame .b.f
  258.     testcbind .b.f <1> "xyz" "lappend x bye.1"
  259.     set x {}
  260.     bind .b.f <1> "abc"
  261.     destroy .b.f
  262.     set x
  263. } {bye.1}
  264. test bind-7.3 {Tk_CreateBinding procedure: append} {
  265.     catch {destroy .b.c}
  266.     canvas .b.c
  267.     .b.c bind foo <1> "button 1"
  268.     .b.c bind foo <1> "+more button 1"
  269.     .b.c bind foo <1>
  270. } {button 1
  271. more button 1}
  272. test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} {
  273.     catch {destroy .b.c}
  274.     canvas .b.c
  275.     .b.c bind foo <1> "+button 1"
  276.     .b.c bind foo <1>
  277. } {button 1}
  278.  
  279. test bind-8.1 {TkCreateBindingProcedure: error} {
  280.     list [catch {testcbind . <xyz> "xyz"} msg] $msg
  281. } {1 {bad event type or keysym "xyz"}}
  282. test bind-8.2 {TkCreateBindingProcedure: new binding} {
  283.     catch {destroy .b.f}
  284.     frame .b.f
  285.     testcbind .b.f <1> "lappend x 1" "lappend x bye.1"
  286.     set x {}
  287.     event gen .b.f <1>
  288.     destroy .b.f
  289.     set x
  290. } {bye.1}
  291. test bind-8.3 {TkCreateBindingProcedure: replace existing} {
  292.     catch {destroy .b.f}
  293.     frame .b.f
  294.     pack .b.f
  295.     set x {}
  296.     testcbind .b.f <1> "lappend x old1" "lappend x bye.old1"
  297.     testcbind .b.f <1> "lappend x new1" "lappend x bye.new1"
  298.     set x
  299. } {bye.old1}
  300. test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} {
  301.     catch {destroy .b.f}
  302.     frame .b.f
  303.     pack .b.f
  304.     update
  305.     testcbind .b.f <1> "lappend x .b.f; testcbind Frame <1> {lappend x Frame}"
  306.     testcbind Frame <1> "lappend x never"
  307.     set x {}
  308.     event gen .b.f <1>
  309.     bind .b.f <1> {}
  310.     set x
  311. } {.b.f Frame}
  312.  
  313. test bind-9.1 {Tk_DeleteBinding procedure} {
  314.     catch {destroy .b.f}
  315.     frame .b.f -class Test -width 150 -height 100
  316.     list [catch {bind .b.f <} msg] $msg
  317. } {0 {}}
  318. test bind-9.2 {Tk_DeleteBinding procedure} {
  319.     catch {destroy .b.f}
  320.     frame .b.f -class Test -width 150 -height 100
  321.     foreach i {a b c d} {
  322.     bind .b.f $i "binding for $i"
  323.     }
  324.     set result {}
  325.     foreach i {b d a c} {
  326.     bind .b.f $i {}
  327.     lappend result [lsort [bind .b.f]]
  328.     }
  329.     set result
  330. } {{a c d} {a c} c {}}
  331. test bind-9.3 {Tk_DeleteBinding procedure} {
  332.     catch {destroy .b.f}
  333.     frame .b.f -class Test -width 150 -height 100
  334.     foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} {
  335.     bind .b.f $i "binding for $i"
  336.     }
  337.     set result {}
  338.     foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} {
  339.     bind .b.f $i {}
  340.     lappend result [lsort [bind .b.f]]
  341.     }
  342.     set result
  343. } {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}}
  344. test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} {
  345.     catch {destroy .b.f}
  346.     frame .b.f
  347.     pack .b.f
  348.     update
  349.     bindtags .b.f {a b c}
  350.     testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1}
  351.     bind b <1> {lappend x b1}
  352.     testcbind c <1> {lappend x c1} {lappend x bye.c1}
  353.     testcbind c <2> {lappend x c2} {lappend x bye.c2}
  354.     set x {}
  355.     event gen .b.f <1>
  356.     bind a <1> {}
  357.     bind b <1> {}
  358.     set x
  359. } {a1 bye.c2 b1 bye.c1 bye.a1}
  360.  
  361. test bind-10.1 {Tk_GetBinding procedure} {
  362.     catch {destroy .b.c}
  363.     canvas .b.c
  364.     list [catch {.b.c bind foo <} msg] $msg
  365. } {1 {no event type or button # or keysym}}
  366. test bind-10.2 {Tk_GetBinding procedure} {
  367.     catch {destroy .b.c}
  368.     canvas .b.c
  369.     .b.c bind foo a Test
  370.     .b.c bind foo a
  371. } {Test}
  372. test bind-10.3 {Tk_GetBinding procedure: C binding} {
  373.     catch {destroy .b.f}
  374.     frame .b.f
  375.     testcbind .b.f <1> "foo"
  376.     list [bind .b.f] [bind .b.f <1>]
  377. } {<Button-1> {}}
  378.  
  379. test bind-11.1 {Tk_GetAllBindings procedure} {
  380.     catch {destroy .b.f}
  381.     frame .b.f -class Test -width 150 -height 100
  382.     foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" {
  383.     bind .b.f $i Test
  384.     }
  385.     lsort [bind .b.f]
  386. } {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~}
  387. test bind-11.2 {Tk_GetAllBindings procedure} {
  388.     catch {destroy .b.f}
  389.     frame .b.f -class Test -width 150 -height 100
  390.     foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" {
  391.     bind .b.f $i Test
  392.     }
  393.     lsort [bind .b.f]
  394. } {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>}
  395. test bind-11.3 {Tk_GetAllBindings procedure} {
  396.     catch {destroy .b.f}
  397.     frame .b.f -class Test -width 150 -height 100
  398.     foreach i "<Double-Triple-1> abcd a<Leave>b" {
  399.     bind .b.f $i Test
  400.     }
  401.     lsort [bind .b.f]
  402. } {<Triple-Button-1> a<Leave>b abcd}
  403.  
  404.  
  405. test bind-12.1 {Tk_DeleteAllBindings procedure} {
  406.     catch {destroy .b.f}
  407.     frame .b.f -class Test -width 150 -height 100
  408.     destroy .b.f
  409. } {}
  410. test bind-12.2 {Tk_DeleteAllBindings procedure} {
  411.     catch {destroy .b.f}
  412.     frame .b.f -class Test -width 150 -height 100
  413.     foreach i "a b c <Meta-1> <Alt-a> <Control-a>" {
  414.     bind .b.f $i x
  415.     }
  416.     destroy .b.f
  417. } {}
  418. test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} {
  419.     catch {destroy .b.f}
  420.     frame .b.f
  421.     pack .b.f
  422.     update
  423.     testcbind .b.f <1> {lappend x before; event gen .b.f <2>; lappend x after} {lappend x bye.f1}
  424.     testcbind .b.f <2> {destroy .b.f} {lappend x bye.f2}
  425.     bind .b.f <Destroy> {lappend x fDestroy}
  426.     testcbind .b.f <3> {foo} {lappend x bye.f3}
  427.     set x {}
  428.     event gen .b.f <1>
  429.     set x
  430. } {before fDestroy bye.f3 bye.f2 after bye.f1}
  431.  
  432. bind Test <KeyPress> {lappend x "%W %K Test press any"}
  433. bind all <KeyPress> {lappend x "%W %K all press any"}
  434. bind Test a {lappend x "%W %K Test press a"}
  435. bind all x {lappend x "%W %K all press x"}
  436.  
  437. test bind-13.1 {Tk_BindEvent procedure} {
  438.     setup
  439.     bind .b.f a {lappend x "%W %K .b.f press a"}
  440.     set x {}
  441.     event gen .b.f <Key-a>
  442.     event gen .b.f <Key-b>
  443.     event gen .b.f <Key-x>
  444.     set x
  445. } {{.b.f a .b.f press a} {.b.f a Test press a} {.b.f a all press any} {.b.f b Test press any} {.b.f b all press any} {.b.f x Test press any} {.b.f x all press x}}
  446.  
  447. bind Test <KeyPress> {lappend x "%W %K Test press any"; break}
  448. bind all <KeyPress> {continue; lappend x "%W %K all press any"}
  449.  
  450. test bind-13.2 {Tk_BindEvent procedure} {
  451.     setup
  452.     bind .b.f b {lappend x "%W %K .b.f press a"}
  453.     set x {}
  454.     event gen .b.f <Key-b>
  455.     set x
  456. } {{.b.f b .b.f press a} {.b.f b Test press any}}
  457. if {[info procs bgerror] == "bgerror"} {
  458.     rename bgerror {}
  459. }
  460. proc bgerror args {}
  461. bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test}
  462. test bind-13.3 {Tk_BindEvent procedure} {
  463.     setup
  464.     bind .b.f b {lappend x "%W %K .b.f press a"}
  465.     set x {}
  466.     event gen .b.f <Key-b>
  467.     update
  468.     list $x $errorInfo
  469. } {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test
  470.     while executing
  471. "error Test"
  472.     (command bound to event)}}
  473. rename bgerror {}
  474. test bind-13.4 {Tk_BindEvent procedure} {
  475.     proc foo {} {
  476.     set x 44
  477.     event gen .b.f <Key-a>
  478.     }
  479.     setup
  480.     bind .b.f a {lappend x "%W %K .b.f press a"}
  481.     set x {}
  482.     foo
  483.     set x
  484. } {{.b.f a .b.f press a} {.b.f a Test press a}}
  485. test bind-13.5 {Tk_BindEvent procedure} {
  486.     bind all <Destroy> {lappend x "%W destroyed"}
  487.     set x {}
  488.     list [catch {frame .b.g -gorp foo} msg] $msg $x
  489. } {1 {unknown option "-gorp"} {{.b.g destroyed}}}
  490. foreach i [bind all] {
  491.     bind all $i {}
  492. }
  493. foreach i [bind Test] {
  494.     bind Test $i {}
  495. }
  496. test bind-13.6 {Tk_BindEvent procedure} {
  497.     setup
  498.     bind .b.f z {lappend x "%W z (.b.f binding)"}
  499.     bind Test z {lappend x "%W z (.b.f binding)"}
  500.     bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"}
  501.     set x {}
  502.     event gen .b.f <Key-z>
  503.     bind Test z {}
  504.     bind all z {}
  505.     set x
  506. } {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
  507. test bind-13.7 {Tk_BindEvent procedure} {
  508.     setup
  509.     bind .b.f z {lappend x "%W z (.b.f binding)"}
  510.     bind Test z {lappend x "%W z (.b.f binding)"}
  511.     bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"}
  512.     set x {}
  513.     event gen .b.f <Key-z>
  514.     bind Test z {}
  515.     bind all z {}
  516.     set x
  517. } {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
  518. test bind-13.8 {Tk_BindEvent procedure} {
  519.     setup
  520.     bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"}
  521.     bind .b.f <ButtonPress> {lappend x "%W z (.b.f <ButtonPress> binding)"}
  522.     set x {}
  523.     event gen .b.f <Button-1>
  524.     event gen .b.f <Button-2>
  525.     set x
  526. } {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f <ButtonPress> binding)}}
  527. test bind-13.9 {Tk_BindEvent procedure: ignore NotifyInferior} {
  528.     setup
  529.     bind .b.f <Enter> "lappend x Enter%#"
  530.     bind .b.f <Leave> "lappend x Leave%#"
  531.     set x {}
  532.     event gen .b.f <Enter> -serial 100 -detail NotifyAncestor
  533.     event gen .b.f <Enter> -serial 101 -detail NotifyInferior
  534.     event gen .b.f <Leave> -serial 102 -detail NotifyAncestor
  535.     event gen .b.f <Leave> -serial 103 -detail NotifyInferior
  536.     set x
  537. } {Enter100 Leave102}
  538. test bind-13.10 {Tk_BindEvent procedure: collapse Motions} {
  539.     setup
  540.     bind .b.f <Motion> "lappend x Motion%#(%x,%y)"
  541.     set x {}
  542.     event gen .b.f <Motion> -serial 100 -x 100 -y 200 -when tail 
  543.     update
  544.     event gen .b.f <Motion> -serial 101 -x 200 -y 300 -when tail
  545.     event gen .b.f <Motion> -serial 102 -x 300 -y 400 -when tail 
  546.     update
  547.     set x
  548. } {Motion100(100,200) Motion102(300,400)}
  549. test bind-13.11 {Tk_BindEvent procedure: collapse repeating modifiers} {
  550.     setup
  551.     bind .b.f <Key> "lappend x %K%#"
  552.     bind .b.f <KeyRelease> "lappend x %K%#"
  553.     event gen .b.f <Key-Shift_L> -serial 100 -when tail 
  554.     event gen .b.f <KeyRelease-Shift_L> -serial 101 -when tail 
  555.     event gen .b.f <Key-Shift_L> -serial 102 -when tail 
  556.     event gen .b.f <KeyRelease-Shift_L> -serial 103 -when tail 
  557.     update
  558. } {}
  559. test bind-13.12 {Tk_BindEvent procedure: valid key detail} {
  560.     setup
  561.     bind .b.f <Key> "lappend x Key%K"
  562.     bind .b.f <KeyRelease> "lappend x Release%K"
  563.     set x {}
  564.     event gen .b.f <Key> -keysym a
  565.     event gen .b.f <KeyRelease> -keysym a
  566.     set x
  567. } {Keya Releasea}
  568. test bind-13.13 {Tk_BindEvent procedure: invalid key detail} {
  569.     setup
  570.     bind .b.f <Key> "lappend x Key%K"
  571.     bind .b.f <KeyRelease> "lappend x Release%K"
  572.     set x {}
  573.     event gen .b.f <Key> -keycode 0
  574.     event gen .b.f <KeyRelease> -keycode 0
  575.     set x
  576. } {Key?? Release??}
  577. test bind-13.14 {Tk_BindEvent procedure: button detail} {
  578.     setup
  579.     bind .b.f <Button> "lappend x Button%b"
  580.     bind .b.f <ButtonRelease> "lappend x Release%b"
  581.     set x {}
  582.     event gen .b.f <Button> -button 1
  583.     event gen .b.f <ButtonRelease> -button 3
  584.     set x
  585. } {Button1 Release3}
  586. test bind-13.15 {Tk_BindEvent procedure: virtual detail} {
  587.     setup
  588.     bind .b.f <<Paste>> "lappend x Paste"
  589.     set x {}
  590.     event gen .b.f <<Paste>>
  591.     set x
  592. } {Paste}
  593. test bind-13.16 {Tk_BindEvent procedure: virtual event in event stream} {
  594.     setup
  595.     bind .b.f <<Paste>> "lappend x Paste"
  596.     set x {}
  597.     event gen .b.f <<Paste>>
  598.     set x
  599. } {Paste}
  600. test bind-13.17 {Tk_BindEvent procedure: match detail physical} {
  601.     setup
  602.     bind .b.f <Button-2> {set x Button-2}
  603.     event add <<Paste>> <Button-2>
  604.     bind .b.f <<Paste>> {set x Paste}
  605.     set x {}
  606.     event gen .b.f <Button-2>
  607.     set x
  608. } {Button-2}
  609. test bind-13.18 {Tk_BindEvent procedure: no match detail physical} {
  610.     setup
  611.     event add <<Paste>> <Button-2>
  612.     bind .b.f <<Paste>> {set x Paste}
  613.     set x {}
  614.     event gen .b.f <Button-2>
  615.     set x
  616. } {Paste}
  617. test bind-13.19 {Tk_BindEvent procedure: match detail virtual} {
  618.     setup
  619.     event add <<Paste>> <Button-2>
  620.     bind .b.f <<Paste>> "lappend x Paste"
  621.     set x {}
  622.     event gen .b.f <Button-2>
  623.     set x
  624. } {Paste}
  625. test bind-13.20 {Tk_BindEvent procedure: no match detail virtual} {
  626.     setup
  627.     event add <<Paste>> <Button-2>
  628.     bind .b.f <<Paste>> "lappend x Paste"
  629.     set x {}
  630.     event gen .b.f <Button>
  631.     set x
  632. } {}
  633. test bind-13.21 {Tk_BindEvent procedure: match no-detail physical} {
  634.     setup
  635.     bind .b.f <Button> {set x Button}
  636.     event add <<Paste>> <Button>
  637.     bind .b.f <<Paste>> {set x Paste}
  638.     set x {}
  639.     event gen .b.f <Button-2>
  640.     set x
  641. } {Button}
  642. test bind-13.22 {Tk_BindEvent procedure: no match no-detail physical} {
  643.     setup
  644.     event add <<Paste>> <Button>
  645.     bind .b.f <<Paste>> {set x Paste}
  646.     set x {}
  647.     event gen .b.f <Button-2>
  648.     set x
  649. } {Paste}
  650. test bind-13.23 {Tk_BindEvent procedure: match no-detail virtual} {
  651.     setup
  652.     event add <<Paste>> <Button>
  653.     bind .b.f <<Paste>> "lappend x Paste"
  654.     set x {}
  655.     event gen .b.f <Button-2>
  656.     set x
  657. } {Paste}
  658. test bind-13.24 {Tk_BindEvent procedure: no match no-detail virtual} {
  659.     setup
  660.     event add <<Paste>> <Key>
  661.     bind .b.f <<Paste>> "lappend x Paste"
  662.     set x {}
  663.     event gen .b.f <Button>
  664.     set x
  665. } {}
  666. test bind-13.25 {Tk_BindEvent procedure: precedence} {
  667.     setup
  668.     event add <<Paste>> <Button-2>
  669.     event add <<Copy>> <Button>
  670.     bind .b.f <Button-2> "lappend x Button-2"
  671.     bind .b.f <<Paste>> "lappend x Paste"
  672.     bind .b.f <Button> "lappend x Button"
  673.     bind .b.f <<Copy>> "lappend x Copy"
  674.  
  675.     set x {}
  676.     event gen .b.f <Button-2>
  677.     bind .b.f <Button-2> {}
  678.     event gen .b.f <Button-2>
  679.     bind .b.f <<Paste>> {}
  680.     event gen .b.f <Button-2>
  681.     bind .b.f <Button> {}
  682.     event gen .b.f <Button-2>
  683.     bind .b.f <<Copy>> {}
  684.     event gen .b.f <Button-2>
  685.     set x
  686. } {Button-2 Paste Button Copy}
  687. test bind-13.26 {Tk_BindEvent procedure: no detail virtual pattern list} {
  688.     setup
  689.     bind .b.f <Button-2> {set x Button-2}
  690.     set x {}
  691.     event gen .b.f <Button-2> 
  692.     set x
  693. } {Button-2}
  694. test bind-13.27 {Tk_BindEvent procedure: detail virtual pattern list} {
  695.     setup
  696.     event add <<Paste>> <Button-2>
  697.     bind .b.f <<Paste>> {set x Paste}
  698.     set x {}
  699.     event gen .b.f <Button-2>
  700.     set x
  701. } {Paste}
  702. test bind-13.28 {Tk_BindEvent procedure: no no-detail virtual pattern list} {
  703.     setup
  704.     bind .b.f <Button> {set x Button}
  705.     set x {}
  706.     event gen .b.f <Button-2>
  707.     set x
  708. } {Button}
  709. test bind-13.29 {Tk_BindEvent procedure: no-detail virtual pattern list} {
  710.     setup
  711.     event add <<Paste>> <Button>
  712.     bind .b.f <<Paste>> {set x Paste}
  713.     set x {}
  714.     event gen .b.f <Button-2>
  715.     set x
  716. } {Paste}
  717. test bind-13.30 {Tk_BindEvent procedure: no match} {
  718.     setup
  719.     event gen .b.f <Button-2>
  720. } {}
  721. test bind-13.31 {Tk_BindEvent procedure: match} {
  722.     setup
  723.     bind .b.f <Button-2> {set x Button-2}
  724.     set x {}
  725.     event gen .b.f <Button-2>
  726.     set x
  727. } {Button-2}
  728. test bind-13.32 {Tk_BindEvent procedure: many C bindings cause realloc} {
  729.     setup
  730.     bindtags .b.f {a b c d e f g h i j k l m n o p}
  731.     foreach p [bindtags .b.f] {
  732.     testcbind $p <1> "lappend x $p"
  733.     }
  734.     set x {}
  735.     event gen .b.f <1>
  736.     foreach p [bindtags .b.f] {
  737.     bind $p <1> {}
  738.     }
  739.     set x
  740. } {a b c d e f g h i j k l m n o p}
  741. test bind-13.33 {Tk_BindEvent procedure: multiple tags} {
  742.     setup
  743.     bind .b.f <Button-2> {lappend x .b.f}
  744.     bind Test <Button-2> {lappend x Button}
  745.     set x {}
  746.     event gen .b.f <Button-2>
  747.     bind Test <Button-2> {}
  748.     set x
  749. } {.b.f Button}
  750. test bind-13.34 {Tk_BindEvent procedure: execute C binding} {
  751.     setup
  752.     testcbind .b.f <1> {lappend x 1}
  753.     set x {}
  754.     event gen .b.f <1>
  755.     set x
  756. } {1}
  757. test bind-13.35 {Tk_BindEvent procedure: pending list marked deleted} {
  758.     setup
  759.     testcbind Test <1> {lappend x Test} {lappend x Deleted}
  760.     bind .b.f <1> {lappend x .b.f; destroy .b.f}
  761.     set x {}
  762.     event gen .b.f <1>
  763.     set y [list $x [bind Test]]
  764.     bind Test <1> {}
  765.     set y
  766. } {.b.f <Button-1>}
  767. test bind-13.36 {Tk_BindEvent procedure: C binding marked deleted} {
  768.     setup
  769.     testcbind Test <1> {lappend x Test} {lappend x Deleted}
  770.     bind .b.f <1> {lappend x .b.f; bind Test <1> {}; lappend x after}
  771.     set x {}
  772.     event gen .b.f <1>
  773.     set x
  774. } {.b.f after Deleted}
  775. test bind-13.37 {Tk_BindEvent procedure: C binding gets to run} {
  776.     setup
  777.     testcbind Test <1> {lappend x Test}
  778.     bind .b.f <1> {lappend x .b.f}
  779.     set x {}
  780.     event gen .b.f <1>
  781.     bind Test <1> {}
  782.     set x
  783. } {.b.f Test}
  784. test bind-13.38 {Tk_BindEvent procedure: C binding deleted, refcount == 0} {
  785.     setup
  786.     testcbind .b.f <1> {lappend x hi; bind .b.f <1> {}} {lappend x bye}
  787.     set x {}
  788.     event gen .b.f <1>
  789.     set x
  790. } {hi bye}
  791. test bind-13.39 {Tk_BindEvent procedure: C binding deleted, refcount != 0} {
  792.     setup
  793.     testcbind .b.f <1> {
  794.     lappend x before$n
  795.     if {$n==0} {
  796.         bind .b.f <1> {}
  797.     } else {
  798.         set n [expr $n-1]
  799.         event gen .b.f <1>
  800.     }
  801.     lappend x after$n
  802.     } {lappend x Deleted}
  803.     set n 3
  804.     set x {}
  805.     event gen .b.f <1>
  806.     set x
  807. } {before3 before2 before1 before0 after0 after0 after0 after0 Deleted}
  808. test bind-13.40 {Tk_BindEvent procedure: continue in script} {
  809.     setup
  810.     bind .b.f <Button-2> {lappend x b1; continue; lappend x b2}
  811.     bind Test <Button-2> {lappend x B1; continue; lappend x B2}
  812.     set x {}
  813.     event gen .b.f <Button-2>
  814.     bind Test <Button-2> {}
  815.     set x
  816. } {b1 B1}
  817. test bind-13.41 {Tk_BindEvent procedure: continue in script} {
  818.     setup
  819.     testcbind .b.f <Button-2> {lappend x b1; continue; lappend x b2}
  820.     testcbind Test <Button-2> {lappend x B1; continue; lappend x B2}
  821.     set x {}
  822.     event gen .b.f <Button-2>
  823.     bind Test <Button-2> {}
  824.     set x
  825. } {b1 B1}
  826. test bind-13.42 {Tk_BindEvent procedure: break in script} {
  827.     setup
  828.     bind .b.f <Button-2> {lappend x b1; break; lappend x b2}
  829.     bind Test <Button-2> {lappend x B1; break; lappend x B2}
  830.     set x {}
  831.     event gen .b.f <Button-2>
  832.     bind Test <Button-2> {}
  833.     set x
  834. } {b1}
  835. test bind-13.43 {Tk_BindEvent procedure: break in script} {
  836.     setup
  837.     testcbind .b.f <Button-2> {lappend x b1; break; lappend x b2}
  838.     testcbind Test <Button-2> {lappend x B1; break; lappend x B2}
  839.     set x {}
  840.     event gen .b.f <Button-2>
  841.     bind Test <Button-2> {}
  842.     set x
  843. } {b1}
  844.  
  845. proc bgerror msg {
  846.     global x 
  847.     lappend x $msg
  848. }
  849. test bind-13.44 {Tk_BindEvent procedure: error in script} {
  850.     setup
  851.     bind .b.f <Button-2> {lappend x b1; blap}
  852.     bind Test <Button-2> {lappend x B1}
  853.     set x {}
  854.     event gen .b.f <Button-2>
  855.     update
  856.     bind Test <Button-2> {}
  857.     set x
  858. } {b1 {invalid command name "blap"}}
  859. test bind-13.45 {Tk_BindEvent procedure: error in script} {
  860.     setup
  861.     testcbind .b.f <Button-2> {lappend x b1; blap}
  862.     testcbind Test <Button-2> {lappend x B1}
  863.     set x {}
  864.     event gen .b.f <Button-2>
  865.     update
  866.     bind Test <Button-2> {}
  867.     set x
  868. } {b1 {invalid command name "blap"}}
  869.  
  870. test bind-14.1 {TkBindDeadWindow: no C bindings pending} {
  871.     setup
  872.     bind .b.f <1> x
  873.     testcbind .b.f <2> y
  874.     destroy .b.f
  875. } {}
  876. test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} {
  877.     setup
  878.     testcbind .b.f <Destroy> "lappend x .b.f"
  879.     testcbind Test <Destroy> "lappend x Test"
  880.     set x {}
  881.     destroy .b.f
  882.     bind Test <Destroy> {}
  883.     set x
  884. } {.b.f Test}
  885. test bind-14.3 {TkBindDeadWindow: pending C bindings} {
  886.     setup
  887.     bindtags .b.f {a b c d}
  888.     testcbind a <1> "lappend x a1" "lappend x bye.a1"
  889.     testcbind b <1> "destroy .b.f; lappend x b1" "lappend x bye.b1"
  890.     testcbind c <1> "lappend x c1" "lappend x bye.c1"
  891.     testcbind d <1> "lappend x d1" "lappend x bye.d1"
  892.     bind a <2> "event gen .b.f <1>"
  893.     testcbind b <2> "lappend x b2" "lappend x bye.b2"
  894.     testcbind c <2> "lappend x c2" "lappend x bye.d2"
  895.     bind d <2> "lappend x d2"
  896.     testcbind a <3> "event gen .b.f <2>"
  897.     set x {}
  898.     event gen .b.f <3>
  899.     set y $x
  900.     foreach tag {a b c d} {
  901.     foreach event {<1> <2> <3>} {
  902.         bind $tag $event {}
  903.     }
  904.     }
  905.     set y
  906. } {a1 b1 d2}
  907.     
  908. test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} {
  909.     setup
  910.     bind .b.f ab {set x 1}
  911.     set x 0
  912.     event gen .b.f <Key-a>
  913.     event gen .b.f <KeyRelease-a>
  914.     event gen .b.f <Key-b>
  915.     event gen .b.f <KeyRelease-b>
  916.     set x
  917. } 1
  918. test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} {
  919.     setup
  920.     bind .b.f ab {set x 1}
  921.     set x 0
  922.     event gen .b.f <Key-a>
  923.     event gen .b.f <Enter>
  924.     event gen .b.f <KeyRelease-a>
  925.     event gen .b.f <Leave>
  926.     event gen .b.f <Key-b>
  927.     event gen .b.f <KeyRelease-b>
  928.     set x
  929. } 1
  930. test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} {
  931.     setup
  932.     bind .b.f ab {set x 1}
  933.     set x 0
  934.     event gen .b.f <Key-a>
  935.     event gen .b.f <Button-1>
  936.     event gen .b.f <Key-b>
  937.     set x
  938. } 0
  939. test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} {
  940.     setup
  941.     bind .b.f <Double-1> {set x 1}
  942.     set x 0
  943.     event gen .b.f <Button-1>
  944.     event gen .b.f <ButtonRelease-1>
  945.     event gen .b.f <Button-1>
  946.     event gen .b.f <ButtonRelease-1>
  947.     set x
  948. } 1
  949. test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} {
  950.     setup
  951.     bind .b.f <Double-ButtonRelease> {set x 1}
  952.     set x 0
  953.     event gen .b.f <Button-1>
  954.     event gen .b.f <ButtonRelease-1>
  955.     event gen .b.f <Button-2>
  956.     event gen .b.f <ButtonRelease-2>
  957.     set x
  958. } 1
  959. test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} {
  960.     setup
  961.     bind .b.f <Double-1> {set x 1}
  962.     set x 0
  963.     event gen .b.f <Button-1>
  964.     event gen .b.f <Key-a>
  965.     event gen .b.f <ButtonRelease-1>
  966.     event gen .b.f <Button-1>
  967.     event gen .b.f <ButtonRelease-1>
  968.     set x
  969. } 0
  970. test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} {
  971.     setup
  972.     bind .b.f <Double-1> {set x 1}
  973.     set x 0
  974.     event gen .b.f <Button-1>
  975.     event gen .b.f <Key-Shift_L>
  976.     event gen .b.f <ButtonRelease-1>
  977.     event gen .b.f <Button-1>
  978.     event gen .b.f <ButtonRelease-1>
  979.     set x
  980. } 1
  981. test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} {
  982.     setup
  983.     bind .b.f ab {set x 1}
  984.     set x 0
  985.     event gen .b.f <Key-a>
  986.     event gen .b.f <Key-c>
  987.     event gen .b.f <Key-b>
  988.     set x
  989. } 0
  990. test bind-15.9 {MatchPatterns procedure, modifier checks} {
  991.     setup
  992.     bind .b.f <M1-M2-Key> {set x 1}
  993.     set x 0
  994.     event gen .b.f <Key-a> -state 0x18
  995.     set x
  996. } 1
  997. test bind-15.10 {MatchPatterns procedure, modifier checks} {
  998.     setup
  999.     bind .b.f <M1-M2-Key> {set x 1}
  1000.     set x 0
  1001.     event gen .b.f <Key-a> -state 0xfc
  1002.     set x
  1003. } 1
  1004. test bind-15.11 {MatchPatterns procedure, modifier checks} {
  1005.     setup
  1006.     bind .b.f <M1-M2-Key> {set x 1}
  1007.     set x 0
  1008.     event gen .b.f <Key-a> -state 0x8
  1009.     set x
  1010. } 0
  1011. test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} {nonPortable} {
  1012.     # This test is non-portable because the Shift_L keysym may behave
  1013.     # differently on some platforms.
  1014.     setup
  1015.     bind .b.f aB {set x 1}
  1016.     set x 0
  1017.     event gen .b.f <Key-a>
  1018.     event gen .b.f <Key-Shift_L>
  1019.     event gen .b.f <Key-b> -state 1
  1020.     set x
  1021. } 1
  1022. test bind-15.13 {MatchPatterns procedure, checking detail} {
  1023.     setup
  1024.     bind .b.f ab {set x 1}
  1025.     set x 0
  1026.     event gen .b.f <Key-a>
  1027.     event gen .b.f <Key-c>
  1028.     set x
  1029. } 0
  1030. test bind-15.14 {MatchPatterns procedure, checking "nearby"} {
  1031.     setup
  1032.     bind .b.f <Double-1> {set x 1}
  1033.     set x 0
  1034.     event gen .b.f <Button-2> 
  1035.     event gen .b.f <Button-1> -x 30 -y 40
  1036.     event gen .b.f <Button-1> -x 31 -y 39
  1037.     set x
  1038. } 1
  1039. test bind-15.15 {MatchPatterns procedure, checking "nearby"} {
  1040.     setup
  1041.     bind .b.f <Double-1> {set x 1}
  1042.     set x 0
  1043.     event gen .b.f <Button-2> 
  1044.     event gen .b.f <Button-1> -x 30 -y 40
  1045.     event gen .b.f <Button-1> -x 29 -y 41
  1046.     set x
  1047. } 1
  1048. test bind-15.16 {MatchPatterns procedure, checking "nearby"} {
  1049.     setup
  1050.     bind .b.f <Double-1> {set x 1}
  1051.     set x 0
  1052.     event gen .b.f <Button-2> 
  1053.     event gen .b.f <Button-1> -x 30 -y 40
  1054.     event gen .b.f <Button-1> -x 40 -y 40
  1055.     set x
  1056. } 0
  1057. test bind-15.17 {MatchPatterns procedure, checking "nearby"} {
  1058.     setup
  1059.     bind .b.f <Double-1> {set x 1}
  1060.     set x 0
  1061.     event gen .b.f <Button-2> 
  1062.     event gen .b.f <Button-1> -x 30 -y 40
  1063.     event gen .b.f <Button-1> -x 20 -y 40
  1064.     set x
  1065. } 0
  1066. test bind-15.18 {MatchPatterns procedure, checking "nearby"} {
  1067.     setup
  1068.     bind .b.f <Double-1> {set x 1}
  1069.     set x 0
  1070.     event gen .b.f <Button-2> 
  1071.     event gen .b.f <Button-1> -x 30 -y 40
  1072.     event gen .b.f <Button-1> -x 30 -y 30
  1073.     set x
  1074. } 0
  1075. test bind-15.19 {MatchPatterns procedure, checking "nearby"} {
  1076.     setup
  1077.     bind .b.f <Double-1> {set x 1}
  1078.     set x 0
  1079.     event gen .b.f <Button-2> 
  1080.     event gen .b.f <Button-1> -x 30 -y 40
  1081.     event gen .b.f <Button-1> -x 30 -y 50
  1082.     set x
  1083. } 0
  1084. test bind-15.20 {MatchPatterns procedure, checking "nearby"} {
  1085.     setup
  1086.     bind .b.f <Double-1> {set x 1}
  1087.     set x 0
  1088.     event gen .b.f <Button-2> 
  1089.     event gen .b.f <Button-1> -time 300
  1090.     event gen .b.f <Button-1> -time 700
  1091.     set x
  1092. } 1
  1093. test bind-15.21 {MatchPatterns procedure, checking "nearby"} {
  1094.     setup
  1095.     bind .b.f <Double-1> {set x 1}
  1096.     set x 0
  1097.     event gen .b.f <Button-2> 
  1098.     event gen .b.f <Button-1> -time 300
  1099.     event gen .b.f <Button-1> -time 900
  1100.     set x
  1101. } 0
  1102. test bind-15.22 {MatchPatterns procedure, time wrap-around} {
  1103.     setup
  1104.     bind .b.f <Double-1> {set x 1}
  1105.     set x 0
  1106.     event gen .b.f <Button-1> -time [expr -100]
  1107.     event gen .b.f <Button-1> -time 200
  1108.     set x
  1109. } 1
  1110. test bind-15.23 {MatchPatterns procedure, time wrap-around} {
  1111.     setup
  1112.     bind .b.f <Double-1> {set x 1}
  1113.     set x 0
  1114.     event gen .b.f <Button-1> -time -100
  1115.     event gen .b.f <Button-1> -time 500
  1116.     set x
  1117. } 0
  1118. test bind-15.24 {MatchPatterns procedure, virtual event} {
  1119.     setup
  1120.     event add <<Paste>> <Button-1>
  1121.     bind .b.f <<Paste>> {lappend x paste}
  1122.     set x {}
  1123.     event gen .b.f <Button-1>
  1124.     set x
  1125. } {paste}
  1126. test bind-15.25 {MatchPatterns procedure, reject a  virtual event} {
  1127.     setup
  1128.     event add <<Paste>> <Shift-Button-1>
  1129.     bind .b.f <<Paste>> {lappend x paste}
  1130.     set x {}
  1131.     event gen .b.f <Button-1>
  1132.     set x
  1133. } {}
  1134. test bind-15.26 {MatchPatterns procedure, reject a virtual event} {
  1135.     setup
  1136.     event add <<V1>> <Button>
  1137.     event add <<V2>> <Button-1>
  1138.     event add <<V3>> <Shift-Button-1>
  1139.     bind .b.f <<V2>> "lappend x V2%#"
  1140.     set x {}
  1141.     event gen .b.f <Button> -serial 101
  1142.     event gen .b.f <Button-1> -serial 102
  1143.     event gen .b.f <Shift-Button-1> -serial 103
  1144.     bind .b.f <Shift-Button-1> "lappend x Shift-Button-1"
  1145.     event gen .b.f <Button> -serial 104
  1146.     event gen .b.f <Button-1> -serial 105
  1147.     event gen .b.f <Shift-Button-1> -serial 106
  1148.     set x
  1149. } {V2102 V2103 V2105 Shift-Button-1}
  1150. test bind-15.27 {MatchPatterns procedure, conflict resolution} {
  1151.     setup
  1152.     bind .b.f <KeyPress> {set x 0}
  1153.     bind .b.f a {set x 1}
  1154.     set x none
  1155.     event gen .b.f <Key-a>
  1156.     set x
  1157. } 1
  1158. test bind-15.28 {MatchPatterns procedure, conflict resolution} {
  1159.     setup
  1160.     bind .b.f <KeyPress> {set x 0}
  1161.     bind .b.f a {set x 1}
  1162.     set x none
  1163.     event gen .b.f <Key-b>
  1164.     set x
  1165. } 0
  1166. test bind-15.29 {MatchPatterns procedure, conflict resolution} {
  1167.     setup
  1168.     bind .b.f <KeyPress> {lappend x 0}
  1169.     bind .b.f a {lappend x 1}
  1170.     bind .b.f ba {lappend x 2}
  1171.     set x none
  1172.     event gen .b.f <Key-b>
  1173.     event gen .b.f <KeyRelease-b>
  1174.     event gen .b.f <Key-a>
  1175.     set x
  1176. } {none 0 2}
  1177. test bind-15.30 {MatchPatterns procedure, conflict resolution} {
  1178.     setup
  1179.     bind .b.f <ButtonPress> {set x 0}
  1180.     bind .b.f <1> {set x 1}
  1181.     set x none
  1182.     event gen .b.f <Button-1>
  1183.     set x
  1184. } 1
  1185. test bind-15.31 {MatchPatterns procedure, conflict resolution} {
  1186.     setup
  1187.     bind .b.f <M1-Key> {set x 0}
  1188.     bind .b.f <M2-Key> {set x 1}
  1189.     set x none
  1190.     event gen .b.f <Key-a> -state 0x18
  1191.     set x
  1192. } 1
  1193. test bind-15.32 {MatchPatterns procedure, conflict resolution} {
  1194.     setup
  1195.     bind .b.f <M2-Key> {set x 0}
  1196.     bind .b.f <M1-Key> {set x 1}
  1197.     set x none
  1198.     event gen .b.f <Key-a> -state 0x18
  1199.     set x
  1200. } 1
  1201. test bind-15.33 {MatchPatterns procedure, conflict resolution} {
  1202.     setup
  1203.     bind .b.f <1> {lappend x single}
  1204.     bind Test <1> {lappend x single(Test)}
  1205.     bind Test <Double-1> {lappend x double(Test)}
  1206.     set x {}
  1207.     event gen .b.f <Button-1>
  1208.     event gen .b.f <Button-1>
  1209.     event gen .b.f <Button-1>
  1210.     set x
  1211. } {single single(Test) single double(Test) single double(Test)}
  1212. foreach i [bind Test] {
  1213.     bind Test $i {}
  1214. }
  1215. test bind-16.1 {ExpandPercents procedure} {
  1216.     setup
  1217.     bind .b.f <Enter> {set x abcd}
  1218.     set x none
  1219.     event gen .b.f <Enter>
  1220.     set x
  1221. } abcd
  1222. test bind-16.2 {ExpandPercents procedure} {
  1223.     setup
  1224.     bind .b.f <Enter> {set x %#}
  1225.     set x none
  1226.     event gen .b.f <Enter> -serial 1234
  1227.     set x
  1228. } 1234
  1229. test bind-16.3 {ExpandPercents procedure} {
  1230.     setup
  1231.     bind .b.f <Configure> {set x %a}
  1232.     set x none
  1233.     event gen .b.f <Configure> -above .b -window .b.f
  1234.     set x
  1235. } [winfo id .b]
  1236. test bind-16.4 {ExpandPercents procedure} {
  1237.     setup
  1238.     bind .b.f <Button> {set x %b}
  1239.     set x none
  1240.     event gen .b.f <Button-3>
  1241.     set x
  1242. } 3
  1243. test bind-16.5 {ExpandPercents procedure} {
  1244.     setup
  1245.     bind .b.f <Expose> {set x %c}
  1246.     set x none
  1247.     event gen .b.f <Expose> -count 47
  1248.     set x
  1249. } 47
  1250. test bind-16.6 {ExpandPercents procedure} {
  1251.     setup
  1252.     bind .b.f <Enter> {set x %d}
  1253.     set x none
  1254.     event gen .b.f <Enter> -detail NotifyAncestor
  1255.     set x
  1256. } NotifyAncestor
  1257. test bind-16.7 {ExpandPercents procedure} {
  1258.     setup
  1259.     bind .b.f <Enter> {set x %d}
  1260.     set x none
  1261.     event gen .b.f <Enter> -detail NotifyVirtual
  1262.     set x
  1263. } NotifyVirtual
  1264. test bind-16.8 {ExpandPercents procedure} {
  1265.     setup
  1266.     bind .b.f <Enter> {set x %d}
  1267.     set x none
  1268.     event gen .b.f <Enter> -detail NotifyNonlinear
  1269.     set x
  1270. } NotifyNonlinear
  1271. test bind-16.9 {ExpandPercents procedure} {
  1272.     setup
  1273.     bind .b.f <Enter> {set x %d}
  1274.     set x none
  1275.     event gen .b.f <Enter> -detail NotifyNonlinearVirtual
  1276.     set x
  1277. } NotifyNonlinearVirtual
  1278. test bind-16.10 {ExpandPercents procedure} {
  1279.     setup
  1280.     bind .b.f <Enter> {set x %d}
  1281.     set x none
  1282.     event gen .b.f <Enter> -detail NotifyPointer
  1283.     set x
  1284. } NotifyPointer
  1285. test bind-16.11 {ExpandPercents procedure} {
  1286.     setup
  1287.     bind .b.f <Enter> {set x %d}
  1288.     set x none
  1289.     event gen .b.f <Enter> -detail NotifyPointerRoot
  1290.     set x
  1291. } NotifyPointerRoot
  1292. test bind-16.12 {ExpandPercents procedure} {
  1293.     setup
  1294.     bind .b.f <Enter> {set x %d}
  1295.     set x none
  1296.     event gen .b.f <Enter> -detail NotifyDetailNone
  1297.     set x
  1298. } NotifyDetailNone
  1299. test bind-16.13 {ExpandPercents procedure} {
  1300.     setup
  1301.     bind .b.f <Enter> {set x %f}
  1302.     set x none
  1303.     event gen .b.f <Enter> -focus 1
  1304.     set x
  1305. } 1
  1306. test bind-16.14 {ExpandPercents procedure} {
  1307.     setup
  1308.     bind .b.f <Expose> {set x "%x %y %w %h"}
  1309.     set x none
  1310.     event gen .b.f <Expose> -x 24 -y 18 -width 147 -height 61
  1311.     set x
  1312. } {24 18 147 61}
  1313. test bind-16.15 {ExpandPercents procedure} {
  1314.     setup
  1315.     bind .b.f <Configure> {set x "%x %y %w %h"}
  1316.     set x none
  1317.     event gen .b.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .b.f
  1318.     set x
  1319. } {24 18 147 61}
  1320. test bind-16.16 {ExpandPercents procedure} {
  1321.     setup
  1322.     bind .b.f <Key> {set x "%k"}
  1323.     set x none
  1324.     event gen .b.f <Key> -keycode 146
  1325.     set x
  1326. } 146
  1327. test bind-16.17 {ExpandPercents procedure} {
  1328.     setup
  1329.     bind .b.f <Enter> {set x "%m"}
  1330.     set x none
  1331.     event gen .b.f <Enter> -mode NotifyNormal
  1332.     set x
  1333. } NotifyNormal
  1334. test bind-16.18 {ExpandPercents procedure} {
  1335.     setup
  1336.     bind .b.f <Enter> {set x "%m"}
  1337.     set x none
  1338.     event gen .b.f <Enter> -mode NotifyGrab
  1339.     set x
  1340. } NotifyGrab
  1341. test bind-16.19 {ExpandPercents procedure} {
  1342.     setup
  1343.     bind .b.f <Enter> {set x "%m"}
  1344.     set x none
  1345.     event gen .b.f <Enter> -mode NotifyUngrab
  1346.     set x
  1347. } NotifyUngrab
  1348. test bind-16.20 {ExpandPercents procedure} {
  1349.     setup
  1350.     bind .b.f <Enter> {set x "%m"}
  1351.     set x none
  1352.     event gen .b.f <Enter> -mode NotifyWhileGrabbed
  1353.     set x
  1354. } NotifyWhileGrabbed
  1355. test bind-16.21 {ExpandPercents procedure} {
  1356.     setup
  1357.     bind .b.f <Map> {set x "%o"}
  1358.     set x none
  1359.     event gen .b.f <Map> -override 1 -window .b.f
  1360.     set x
  1361. } 1
  1362. test bind-16.22 {ExpandPercents procedure} {
  1363.     setup
  1364.     bind .b.f <Reparent> {set x "%o"}
  1365.     set x none
  1366.     event gen .b.f <Reparent> -override true -window .b.f
  1367.     set x
  1368. } 1
  1369. test bind-16.23 {ExpandPercents procedure} {
  1370.     setup
  1371.     bind .b.f <Configure> {set x "%o"}
  1372.     set x none
  1373.     event gen .b.f <Configure> -override 1 -window .b.f
  1374.     set x
  1375. } 1
  1376. test bind-16.24 {ExpandPercents procedure} {
  1377.     setup
  1378.     bind .b.f <Circulate> {set x "%p"}
  1379.     set x none
  1380.     event gen .b.f <Circulate> -place PlaceOnTop -window .b.f
  1381.     set x
  1382. } PlaceOnTop
  1383. test bind-16.25 {ExpandPercents procedure} {
  1384.     setup
  1385.     bind .b.f <Circulate> {set x "%p"}
  1386.     set x none
  1387.     event gen .b.f <Circulate> -place PlaceOnBottom -window .b.f
  1388.     set x
  1389. } PlaceOnBottom
  1390. test bind-16.26 {ExpandPercents procedure} {
  1391.     setup
  1392.     bind .b.f <1> {set x "%s"}
  1393.     set x none
  1394.     event gen .b.f <Button-1> -state 122
  1395.     set x
  1396. } 122
  1397. test bind-16.27 {ExpandPercents procedure} {
  1398.     setup
  1399.     bind .b.f <Enter> {set x "%s"}
  1400.     set x none
  1401.     event gen .b.f <Enter> -state 0x3ff
  1402.     set x
  1403. } 1023
  1404. test bind-16.28 {ExpandPercents procedure} {
  1405.     setup
  1406.     bind .b.f <Visibility> {set x "%s"}
  1407.     set x none
  1408.     event gen .b.f <Visibility> -state VisibilityPartiallyObscured
  1409.     set x
  1410. } VisibilityPartiallyObscured
  1411. test bind-16.29 {ExpandPercents procedure} {
  1412.     setup
  1413.     bind .b.f <Visibility> {set x "%s"}
  1414.     set x none
  1415.     event gen .b.f <Visibility> -state VisibilityUnobscured
  1416.     set x
  1417. } VisibilityUnobscured
  1418. test bind-16.30 {ExpandPercents procedure} {
  1419.     setup
  1420.     bind .b.f <Visibility> {set x "%s"}
  1421.     set x none
  1422.     event gen .b.f <Visibility> -state VisibilityFullyObscured
  1423.     set x
  1424. } VisibilityFullyObscured
  1425. test bind-16.31 {ExpandPercents procedure} {
  1426.     setup
  1427.     bind .b.f <Button> {set x "%t"}
  1428.     set x none
  1429.     event gen .b.f <Button> -time 4294
  1430.     set x
  1431. } 4294
  1432. test bind-16.32 {ExpandPercents procedure} {
  1433.     setup
  1434.     bind .b.f <Button> {set x "%x %y"}
  1435.     set x none
  1436.     event gen .b.f <Button> -x 881 -y 432
  1437.     set x
  1438. } {881 432}
  1439. test bind-16.33 {ExpandPercents procedure} {
  1440.     setup
  1441.     bind .b.f <Reparent> {set x "%x %y"}
  1442.     set x none
  1443.     event gen .b.f <Reparent> -x 882 -y 431 -window .b.f
  1444.     set x
  1445. } {882 431}
  1446. test bind-16.34 {ExpandPercents procedure} {
  1447.     setup
  1448.     bind .b.f <Enter> {set x "%x %y"}
  1449.     set x none
  1450.     event gen .b.f <Enter> -x 781 -y 632
  1451.     set x
  1452. } {781 632}
  1453. test bind-16.35 {ExpandPercents procedure} {nonPortable} {
  1454.     setup
  1455.     bind .b.f <Key> {lappend x "%A"}
  1456.     set x {}
  1457.     event gen .b.f <Key-a>
  1458.     event gen .b.f <Key-A> -state 1
  1459.     event gen .b.f <Key-Tab>
  1460.     event gen .b.f <Key-Return>
  1461.     event gen .b.f <Key-F1>
  1462.     event gen .b.f <Key-Shift_L>
  1463.     event gen .b.f <Key-space>
  1464.     event gen .b.f <Key-dollar> -state 1
  1465.     event gen .b.f <Key-braceleft> -state 1
  1466.     set x
  1467. } "a A {    } {\r} {{}} {{}} { } {\$} \\\{"
  1468. test bind-16.36 {ExpandPercents procedure} {
  1469.     setup
  1470.     bind .b.f <Configure> {set x "%B"}
  1471.     set x none
  1472.     event gen .b.f <Configure> -borderwidth 24 -window .b.f
  1473.     set x
  1474. } 24
  1475. test bind-16.37 {ExpandPercents procedure} {
  1476.     setup
  1477.     bind .b.f <Enter> {set x "%E"}
  1478.     set x none
  1479.     event gen .b.f <Enter> -sendevent 1
  1480.     set x
  1481. } 1
  1482. test bind-16.38 {ExpandPercents procedure} {nonPortable} {
  1483.     setup
  1484.     bind .b.f <Key> {lappend x %K}
  1485.     set x {}
  1486.     event gen .b.f <Key-a>
  1487.     event gen .b.f <Key-A> -state 1
  1488.     event gen .b.f <Key-Tab>
  1489.     event gen .b.f <Key-F1>
  1490.     event gen .b.f <Key-Shift_L>
  1491.     event gen .b.f <Key-space>
  1492.     event gen .b.f <Key-dollar> -state 1
  1493.     event gen .b.f <Key-braceleft> -state 1
  1494.     set x
  1495. } {a A Tab F1 Shift_L space dollar braceleft}
  1496. test bind-16.39 {ExpandPercents procedure} {
  1497.     setup
  1498.     bind .b.f <Key> {set x "%N"}
  1499.     set x none
  1500.     event gen .b.f <Key-a>
  1501.     set x
  1502. } 97
  1503. test bind-16.40 {ExpandPercents procedure} {
  1504.     setup
  1505.     bind .b.f <Key> {set x "%S"}
  1506.     set x none
  1507.     event gen .b.f <Key-a> -subwindow .b
  1508.     set x
  1509. } [winfo id .b]
  1510. test bind-16.41 {ExpandPercents procedure} {
  1511.     setup
  1512.     bind .b.f <Key> {set x "%T"}
  1513.     set x none
  1514.     event gen .b.f <Key>
  1515.     set x
  1516. } 2
  1517. test bind-16.42 {ExpandPercents procedure} {
  1518.     setup
  1519.     bind .b.f <Key> {set x "%W"}
  1520.     set x none
  1521.     event gen .b.f <Key>
  1522.     set x
  1523. } .b.f
  1524. test bind-16.43 {ExpandPercents procedure} {
  1525.     setup
  1526.     bind .b.f <Button> {set x "%X %Y"}
  1527.     set x none
  1528.     event gen .b.f <Button> -rootx 422 -rooty 13
  1529.     set x
  1530. } {422 13}
  1531.  
  1532.  
  1533. test bind-17.1 {event command} {
  1534.     list [catch {event} msg] $msg
  1535. } {1 {wrong # args: should be "event option ?arg1?"}}
  1536. test bind-17.2 {event command} {
  1537.     list [catch {event {}} msg] $msg
  1538. } {1 {bad option "": should be add, delete, generate, info}}
  1539. test bind-17.3 {event command: add} {
  1540.     list [catch {event add} msg] $msg
  1541. } {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}}
  1542. test bind-17.4 {event command: add 1} {
  1543.     setup
  1544.     event add <<Paste>> <Control-v>
  1545.     event info <<Paste>>
  1546. } {<Control-Key-v>}
  1547. test bind-17.5 {event command: add 2} {
  1548.     setup
  1549.     event add <<Paste>> <Control-v> <Button-2>
  1550.     lsort [event info <<Paste>>]
  1551. } {<Button-2> <Control-Key-v>}
  1552. test bind-17.6 {event command: add with error} {
  1553.     setup
  1554.     list [catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} \
  1555.         msg] $msg [lsort [event info <<Paste>>]]
  1556. } {1 {bad event type or keysym "xyz"} {<Button-2> <Control-Key-v> abc}}
  1557. test bind-17.7 {event command: delete} {
  1558.     list [catch {event delete} msg] $msg
  1559. } {1 {wrong # args: should be "event delete virtual ?sequence sequence ...?"}}
  1560. test bind-17.8 {event command: delete many} {
  1561.     setup
  1562.     event add <<Paste>> <3> <1> <2> t
  1563.     event delete <<Paste>> <1> <2>
  1564.     lsort [event info <<Paste>>]
  1565. } {<Button-3> t}
  1566. test bind-17.9 {event command: delete all} {
  1567.     setup
  1568.     event add <<Paste>> a b
  1569.     event delete <<Paste>>
  1570.     event info <<Paste>>
  1571. } {}
  1572. test bind-17.10 {event command: delete 1} {
  1573.     setup
  1574.     event add <<Paste>> a b c
  1575.     event delete <<Paste>> b
  1576.     lsort [event info <<Paste>>]
  1577. } {a c}
  1578. test bind-17.11 {event command: info name} {
  1579.     setup
  1580.     event add <<Paste>> a b c
  1581.     lsort [event info <<Paste>>]
  1582. } {a b c}
  1583. test bind-17.12 {event command: info all} {
  1584.     setup
  1585.     event add <<Paste>> a
  1586.     event add <<Alive>> b
  1587.     lsort [event info]
  1588. } {<<Alive>> <<Paste>>}
  1589. test bind-17.13 {event command: info error} {
  1590.     list [catch {event info <<Paste>> <Control-v>} msg] $msg
  1591. } {1 {wrong # args: should be "event info ?virtual?"}}
  1592. test bind-17.14 {event command: generate} {
  1593.     list [catch {event generate} msg] $msg
  1594. } {1 {wrong # args: should be "event generate window event ?options?"}}
  1595. test bind-17.15 {event command: generate} {
  1596.     setup
  1597.     bind .b.f <1> "lappend x 1"
  1598.     set x {}
  1599.     event generate .b.f <1>
  1600.     set x
  1601. } {1}
  1602. test bind-17.16 {event command: generate} {
  1603.     list [catch {event generate .b.f <xyz>} msg] $msg
  1604. } {1 {bad event type or keysym "xyz"}}
  1605. test bind-17.17 {event command} {
  1606.     list [catch {event foo} msg] $msg
  1607. } {1 {bad option "foo": should be add, delete, generate, info}}
  1608.  
  1609.  
  1610. test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} {
  1611.     list [catch {event add asd <Ctrl-v>} msg] $msg
  1612. } {1 {virtual event "asd" is badly formed}}
  1613. test bind-18.2 {CreateVirtualEvent procedure: FindSequence} {
  1614.     list [catch {event add <<asd>> <Ctrl-v>} msg] $msg
  1615. } {1 {bad event type or keysym "Ctrl"}}
  1616. test bind-18.3 {CreateVirtualEvent procedure: new physical} {
  1617.     setup
  1618.     event add <<xyz>> <Control-v>
  1619.     event info <<xyz>>
  1620. } {<Control-Key-v>}
  1621. test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} {
  1622.     setup
  1623.     event add <<xyz>> <Control-v> 
  1624.     event add <<xyz>> <Control-v>
  1625.     event info <<xyz>>
  1626. } {<Control-Key-v>}
  1627. test bind-18.5 {CreateVirtualEvent procedure: existing physical} {
  1628.     setup
  1629.     event add <<xyz>> <Control-v>
  1630.     event add <<abc>> <Control-v>
  1631.     list [lsort [event info]] [event info <<xyz>>] [event info <<abc>>]
  1632. } {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>}
  1633. test bind-18.6 {CreateVirtualEvent procedure: new virtual} {
  1634.     setup
  1635.     event add <<xyz>> <Control-v>
  1636.     list [event info] [event info <<xyz>>]
  1637. } {<<xyz>> <Control-Key-v>}
  1638. test bind-18.7 {CreateVirtualEvent procedure: existing virtual} {
  1639.     setup
  1640.     event add <<xyz>> <Control-v>
  1641.     event add <<xyz>> <Button-2>
  1642.     list [event info] [lsort [event info <<xyz>>]]
  1643. } {<<xyz>> {<Button-2> <Control-Key-v>}}
  1644.  
  1645.  
  1646. test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} {
  1647.     list [catch {event add xyz {}} msg] $msg
  1648. } {1 {virtual event "xyz" is badly formed}}
  1649. test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} {
  1650.     setup
  1651.     event delete <<xyz>>
  1652.     event info
  1653. } {}
  1654. test bind-19.3 {DeleteVirtualEvent procedure: delete 1} {
  1655.     setup
  1656.     event add <<xyz>> <Control-v>
  1657.     event delete <<xyz>> <Control-v>
  1658.     event info <<xyz>>
  1659. } {}
  1660. test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} {
  1661.     setup
  1662.     event add <<xyz>> <Control-v>
  1663.     event delete <<xyz>> <Button-1>
  1664.     event info <<xyz>>
  1665. } {<Control-Key-v>}
  1666. test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} {
  1667.     setup
  1668.     event add <<xyz>> <Control-v>
  1669.     list [catch {event delete <<xyz>> <xyz>} msg] $msg
  1670. } {1 {bad event type or keysym "xyz"}}
  1671. test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} {
  1672.     setup
  1673.     event add <<xyz>> <Control-v>
  1674.     list [catch {event delete <<xyz>> <<Paste>>} msg] $msg
  1675. } {1 {virtual event not allowed in definition of another virtual event}}
  1676. test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} {
  1677.     setup
  1678.     event add <<xyz>> <Control-v>
  1679.     event delete <<xyz>>
  1680.     event info 
  1681. } {}
  1682. test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} {
  1683.     setup
  1684.     event add <<xyz>> <Control-v>
  1685.     event delete <<xyz>> <Control-v>
  1686.     event info 
  1687. } {}
  1688. test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} {
  1689.     setup
  1690.     event add <<xyz>> <Control-v> <Control-w> <Control-x>
  1691.     event delete <<xyz>>
  1692.     event info
  1693. } {}
  1694. test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} {
  1695.     setup
  1696.     event add <<xyz>> <Control-v> <Control-w> <Control-x>
  1697.     event delete <<xyz>> <Control-w>
  1698.     lsort [event info <<xyz>>]
  1699. } {<Control-Key-v> <Control-Key-x>}
  1700. test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} {
  1701.     setup
  1702.     event add <<xyz>> <Button-2>
  1703.     bind .b.f <<xyz>> {lappend x %#}
  1704.     set x {}
  1705.     event gen .b.f <Button-2> -serial 101
  1706.     event delete <<xyz>>
  1707.     event gen .b.f <Button-2> -serial 102
  1708.     set x
  1709. } {101}
  1710. test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} {
  1711.     setup
  1712.     event add <<abc>> <Control-Button-2>
  1713.     event add <<xyz>> <Button-2>
  1714.     bind .b.f <<xyz>> {lappend x xyz}
  1715.     bind .b.f <<abc>> {lappend x abc}
  1716.     set x {}
  1717.     event gen .b.f <Button-2>
  1718.     event gen .b.f <Control-Button-2>
  1719.     event delete <<xyz>> 
  1720.     event gen .b.f <Button-2>
  1721.     event gen .b.f <Control-Button-2>
  1722.     list $x [event info <<abc>>]
  1723. } {{xyz abc abc} <Control-Button-2>}
  1724. test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} {
  1725.     setup
  1726.     event add <<def>> <Shift-Button-2>
  1727.     event add <<xyz>> <Button-2>
  1728.     event add <<abc>> <Control-Button-2>
  1729.     bind .b.f <<xyz>> {lappend x xyz}
  1730.     bind .b.f <<abc>> {lappend x abc}
  1731.     bind .b.f <<def>> {lappend x def}
  1732.     set x {}
  1733.     event gen .b.f <Button-2>
  1734.     event gen .b.f <Control-Button-2>
  1735.     event gen .b.f <Shift-Button-2>
  1736.     event delete <<xyz>>
  1737.     event gen .b.f <Button-2>
  1738.     event gen .b.f <Control-Button-2>
  1739.     event gen .b.f <Shift-Button-2>
  1740.     list $x [event info <<def>>] [event info <<xyz>>] [event info <<abc>>]
  1741. } {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>}
  1742. test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} {
  1743.     setup
  1744.     event add <<xyz>> <Button-2>
  1745.     event add <<abc>> <Control-Button-2>
  1746.     event add <<def>> <Shift-Button-2>
  1747.     bind .b.f <<xyz>> {lappend x xyz}
  1748.     bind .b.f <<abc>> {lappend x abc}
  1749.     bind .b.f <<def>> {lappend x def}
  1750.     set x {}
  1751.     event gen .b.f <Button-2>
  1752.     event gen .b.f <Control-Button-2>
  1753.     event gen .b.f <Shift-Button-2>
  1754.     event delete <<xyz>> 
  1755.     event gen .b.f <Button-2>
  1756.     event gen .b.f <Control-Button-2>
  1757.     event gen .b.f <Shift-Button-2>
  1758.     list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
  1759. } {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>}
  1760. test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} {
  1761.     setup
  1762.     pack [frame .b.g -class Test -width 150 -height 100]
  1763.     pack [frame .b.h -class Test -width 150 -height 100]
  1764.     update
  1765.     event add <<xyz>> <Button-2>
  1766.     event add <<abc>> <Button-2>
  1767.     event add <<def>> <Button-2>
  1768.     bind .b.f <<xyz>> {lappend x xyz}
  1769.     bind .b.g <<abc>> {lappend x abc}
  1770.     bind .b.h <<def>> {lappend x def}
  1771.     set x {}
  1772.     event gen .b.f <Button-2>
  1773.     event gen .b.g <Button-2>
  1774.     event gen .b.h <Button-2>
  1775.     event delete <<xyz>> 
  1776.     event gen .b.f <Button-2>
  1777.     event gen .b.g <Button-2>
  1778.     event gen .b.h <Button-2>
  1779.     destroy .b.g
  1780.     destroy .b.h
  1781.     list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
  1782. } {{xyz abc def abc def} {} <Button-2> <Button-2>}
  1783. test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} {
  1784.     setup
  1785.     pack [frame .b.g -class Test -width 150 -height 100]
  1786.     pack [frame .b.h -class Test -width 150 -height 100]
  1787.     update
  1788.     event add <<xyz>> <Button-2>
  1789.     event add <<abc>> <Button-2>
  1790.     event add <<def>> <Button-2>
  1791.     bind .b.f <<xyz>> {lappend x xyz}
  1792.     bind .b.g <<abc>> {lappend x abc}
  1793.     bind .b.h <<def>> {lappend x def}
  1794.     set x {}
  1795.     event gen .b.f <Button-2>
  1796.     event gen .b.g <Button-2>
  1797.     event gen .b.h <Button-2>
  1798.     event delete <<abc>>
  1799.     event gen .b.f <Button-2>
  1800.     event gen .b.g <Button-2>
  1801.     event gen .b.h <Button-2>
  1802.     destroy .b.g
  1803.     destroy .b.h
  1804.     list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
  1805. } {{xyz abc def xyz def} <Button-2> {} <Button-2>}
  1806. test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} {
  1807.     setup
  1808.     pack [frame .b.g -class Test -width 150 -height 100]
  1809.     pack [frame .b.h -class Test -width 150 -height 100]
  1810.     update
  1811.     event add <<xyz>> <Button-2>
  1812.     event add <<abc>> <Button-2>
  1813.     event add <<def>> <Button-2>
  1814.     bind .b.f <<xyz>> {lappend x xyz}
  1815.     bind .b.g <<abc>> {lappend x abc}
  1816.     bind .b.h <<def>> {lappend x def}
  1817.     set x {}
  1818.     event gen .b.f <Button-2>
  1819.     event gen .b.g <Button-2>
  1820.     event gen .b.h <Button-2>
  1821.     event delete <<def>> 
  1822.     event gen .b.f <Button-2>
  1823.     event gen .b.g <Button-2>
  1824.     event gen .b.h <Button-2>
  1825.     destroy .b.g
  1826.     destroy .b.h
  1827.     list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
  1828. } {{xyz abc def xyz abc} <Button-2> <Button-2> {}}
  1829.  
  1830.  
  1831. test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} {
  1832.     list [catch {event info asd} msg] $msg
  1833. } {1 {virtual event "asd" is badly formed}}
  1834. test bind-20.2 {GetVirtualEvent procedure: non-existent event} {
  1835.     event info <<asd>>
  1836. } {}
  1837. test bind-20.3 {GetVirtualEvent procedure: owns 1} {
  1838.     setup
  1839.     event add <<xyz>> <Control-Key-v>
  1840.     event info <<xyz>>
  1841. } {<Control-Key-v>}
  1842. test bind-20.4 {GetVirtualEvent procedure: owns many} {
  1843.     setup
  1844.     event add <<xyz>> <Control-v> <Button-2> spack
  1845.     event info <<xyz>>
  1846. } {<Control-Key-v> <Button-2> spack}
  1847.  
  1848.  
  1849. test bind-21.1 {GetAllVirtualEvents procedure: no events} {
  1850.     setup
  1851.     event info
  1852. } {}
  1853. test bind-21.2 {GetAllVirtualEvents procedure: 1 event} {
  1854.     setup
  1855.     event add <<xyz>> <Control-v>
  1856.     event info
  1857. } {<<xyz>>}
  1858. test bind-21.3 {GetAllVirtualEvents procedure: many events} {
  1859.     setup
  1860.     event add <<xyz>> <Control-v>
  1861.     event add <<xyz>> <Button-2>
  1862.     event add <<abc>> <Control-v>
  1863.     event add <<def>> <Key-F6>
  1864.     lsort [event info]
  1865. } {<<abc>> <<def>> <<xyz>>}
  1866.  
  1867. test bind-22.1 {HandleEventGenerate} {
  1868.     list [catch {event gen .xyz <Control-v>} msg] $msg
  1869. } {1 {bad window path name ".xyz"}}
  1870. test bind-22.2 {HandleEventGenerate} {
  1871.     list [catch {event gen zzz <Control-v>} msg] $msg
  1872. } {1 {bad window name/identifier "zzz"}}
  1873. test bind-22.3 {HandleEventGenerate} {
  1874.     list [catch {event gen 47 <Control-v>} msg] $msg
  1875. } {1 {window id "47" doesn't exist in this application}}
  1876. test bind-22.4 {HandleEventGenerate} {
  1877.     setup
  1878.     bind .b.f <Button> {set x "%s %b"}
  1879.     set x {}
  1880.     event gen [winfo id .b.f] <Control-Button-1>
  1881.     set x
  1882. } {4 1}
  1883. test bind-22.5 {HandleEventGenerate} {
  1884.     list [catch {event gen . <xyz>} msg] $msg
  1885. } {1 {bad event type or keysym "xyz"}}
  1886. test bind-22.6 {HandleEventGenerate} {
  1887.     list [catch {event gen . <Double-Button-1>} msg] $msg
  1888. } {1 {Double or Triple modifier not allowed}}
  1889. test bind-22.7 {HandleEventGenerate} {
  1890.     list [catch {event gen . xyz} msg] $msg
  1891. } {1 {only one event specification allowed}}
  1892. test bind-22.8 {HandleEventGenerate} {
  1893.     list [catch {event gen . <Button> -button} msg] $msg
  1894. } {1 {value for "-button" missing}}
  1895. test bind-22.9 {HandleEventGenerate} {
  1896.     setup
  1897.     bind .b.f <Button> {set x "%s %b"}
  1898.     set x {}
  1899.     event gen .b.f <Control-Button-1>
  1900.     set x
  1901. } {4 1}
  1902. test bind-22.10 {HandleEventGenerate} {
  1903.     setup
  1904.     bind .b.f <Key> {set x "%s %K"}
  1905.     set x {}
  1906.     event gen .b.f <Control-Key-1>
  1907.     set x
  1908. } {4 1}
  1909. test bind-22.11 {HandleEventGenerate} {
  1910.     setup
  1911.     bind .b.f <<Paste>> {set x "%s"}
  1912.     set x {}
  1913.     event gen .b.f <<Paste>> -state 1
  1914.     set x
  1915. } {1}
  1916. test bind-22.12 {HandleEventGenerate} {
  1917.     setup
  1918.     bind .b.f <Motion> {set x "%s"}
  1919.     set x {}
  1920.     event gen .b.f <Control-Motion>
  1921.     set x
  1922. } {4}
  1923. test bind-22.13 {HandleEventGenerate} {
  1924.     setup
  1925.     bind .b.f <Button> {lappend x %#}
  1926.     set x {}
  1927.     event gen .b.f <Button> -when now -serial 100
  1928.     set x
  1929. } {100}
  1930. test bind-22.14 {HandleEventGenerate} {
  1931.     setup
  1932.     bind .b.f <Button> {lappend x %#}
  1933.     set x {}
  1934.     event gen .b.f <Button> -when head -serial 100
  1935.     event gen .b.f <Button> -when head -serial 101
  1936.     event gen .b.f <Button> -when head -serial 102
  1937.     lappend x foo
  1938.     update
  1939.     set x
  1940. } {foo 102 101 100}
  1941. test bind-22.15 {HandleEventGenerate} {
  1942.     setup
  1943.     bind .b.f <Button> {lappend x %#}
  1944.     set x {}
  1945.     event gen .b.f <Button> -when head -serial 99
  1946.     event gen .b.f <Button> -when mark -serial 100
  1947.     event gen .b.f <Button> -when mark -serial 101
  1948.     event gen .b.f <Button> -when mark -serial 102
  1949.     lappend x foo
  1950.     update
  1951.     set x
  1952. } {foo 100 101 102 99}
  1953. test bind-22.16 {HandleEventGenerate} {
  1954.     setup
  1955.     bind .b.f <Button> {lappend x %#}
  1956.     set x {}
  1957.     event gen .b.f <Button> -when head -serial 99
  1958.     event gen .b.f <Button> -when tail -serial 100
  1959.     event gen .b.f <Button> -when tail -serial 101
  1960.     event gen .b.f <Button> -when tail -serial 102
  1961.     lappend x foo
  1962.     update
  1963.     set x
  1964. } {foo 99 100 101 102}
  1965. test bind-22.17 {HandleEventGenerate} {
  1966.     list [catch {event gen . <Button> -when xyz} msg] $msg
  1967. } {1 {bad position "xyz": should be now, head, mark, tail}}
  1968. set i 14
  1969. foreach check {
  1970.     {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
  1971.     {<Configure> %a {-above .b} {[winfo id .b]}}
  1972.     {<Configure> %a {-above xyz} {{1 {expected integer but got "xyz"}}}}
  1973.     {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
  1974.     {<Key> %b    {-above .} {{1 {bad option to <Key> event: "-above"}}}}
  1975.  
  1976.     {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}    
  1977.     {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
  1978.     {<Key> %k        {-borderwidth 2i} {{1 {bad option to <Key> event: "-borderwidth"}}}}
  1979.  
  1980.     {<Button> %b    {-button xyz} {{1 {expected integer but got "xyz"}}}}
  1981.     {<Button> %b    {-button 1} 1}
  1982.     {<Key> %k        {-button 1} {{1 {bad option to <Key> event: "-button"}}}}
  1983.  
  1984.     {<Expose> %c    {-count xyz} {{1 {expected integer but got "xyz"}}}}
  1985.     {<Expose> %c    {-count 20} 20}
  1986.     {<Key> %b        {-count 20} {{1 {bad option to <Key> event: "-count"}}}}
  1987.  
  1988.     {<Enter> %d        {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, NotifyDetailNone}}}}
  1989.     {<FocusIn> %d   {-detail NotifyVirtual} {{}}}
  1990.     {<Enter> %d        {-detail NotifyVirtual} NotifyVirtual}
  1991.     {<Key> %k        {-detail NotifyVirtual} {{1 {bad option to <Key> event: "-detail"}}}}
  1992.  
  1993.     {<Enter> %f        {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
  1994.     {<Enter> %f        {-focus 1} 1}
  1995.     {<Key> %k        {-focus 1} {{1 {bad option to <Key> event: "-focus"}}}}
  1996.  
  1997.     {<Expose> %h    {-height xyz} {{1 {bad screen distance "xyz"}}}}
  1998.     {<Expose> %h    {-height 2i} {[winfo pixels .b.f 2i]}}
  1999.     {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}}
  2000.     {<Key> %k        {-height 2i} {{1 {bad option to <Key> event: "-height"}}}}
  2001.  
  2002.     {<Key> %k        {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
  2003.     {<Key> %k        {-keycode 20} 20}
  2004.     {<Button> %b    {-keycode 20} {{1 {bad option to <Button> event: "-keycode"}}}}
  2005.  
  2006.     {<Key> %K        {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
  2007.     {<Key> %K        {-keysym a} a}
  2008.     {<Button> %b    {-keysym a} {{1 {bad option to <Button> event: "-keysym"}}}}
  2009.  
  2010.     {<Enter> %m        {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, NotifyWhileGrabbed}}}}
  2011.     {<Enter> %m        {-mode NotifyNormal} NotifyNormal}
  2012.     {<FocusIn> %m   {-mode NotifyNormal} {{}}}
  2013.     {<Key> %k        {-mode NotifyNormal} {{1 {bad option to <Key> event: "-mode"}}}}
  2014.  
  2015.     {<Map> %o        {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
  2016.     {<Map> %o        {-override 1} 1}
  2017.     {<Reparent> %o  {-override 1} 1}
  2018.     {<Configure> %o {-override 1} 1}
  2019.     {<Key> %k        {-override 1} {{1 {bad option to <Key> event: "-override"}}}}
  2020.  
  2021.     {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, PlaceOnBottom}}}}
  2022.     {<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
  2023.     {<Key> %k        {-place PlaceOnTop} {{1 {bad option to <Key> event: "-place"}}}}
  2024.  
  2025.     {<Key> %R        {-root .xyz} {{1 {bad window path name ".xyz"}}}}
  2026.     {<Key> %R        {-root .b} {[winfo id .b]}}
  2027.     {<Key> %R        {-root xyz} {{1 {expected integer but got "xyz"}}}}
  2028.     {<Key> %R        {-root [winfo id .b]} {[winfo id .b]}}
  2029.     {<Button> %R    {-root .b} {[winfo id .b]}}
  2030.     {<Motion> %R    {-root .b} {[winfo id .b]}}
  2031.     {<<Paste>> %R   {-root .b} {[winfo id .b]}}
  2032.     {<Enter> %R        {-root .b} {[winfo id .b]}}
  2033.     {<Configure> %R {-root .b} {{1 {bad option to <Configure> event: "-root"}}}}
  2034.  
  2035.     {<Key> %X        {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
  2036.     {<Key> %X        {-rootx 2i} {[winfo pixels .b.f 2i]}}
  2037.     {<Button> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
  2038.     {<Motion> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
  2039.     {<<Paste>> %X   {-rootx 2i} {[winfo pixels .b.f 2i]}}
  2040.     {<Enter> %X        {-rootx 2i} {[winfo pixels .b.f 2i]}}
  2041.     {<Configure> %X {-rootx 2i} {{1 {bad option to <Configure> event: "-rootx"}}}}
  2042.  
  2043.     {<Key> %Y        {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
  2044.     {<Key> %Y        {-rooty 2i} {[winfo pixels .b.f 2i]}}
  2045.     {<Button> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
  2046.     {<Motion> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
  2047.     {<<Paste>> %Y   {-rooty 2i} {[winfo pixels .b.f 2i]}}
  2048.     {<Enter> %Y        {-rooty 2i} {[winfo pixels .b.f 2i]}}
  2049.     {<Configure> %Y {-rooty 2i} {{1 {bad option to <Configure> event: "-rooty"}}}}
  2050.  
  2051.     {<Key> %E        {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
  2052.     {<Key> %E        {-sendevent 1} 1}
  2053.     {<Key> %E        {-sendevent yes} 1}
  2054.     {<Key> %E        {-sendevent 43} 43}
  2055.  
  2056.     {<Key> %#        {-serial xyz} {{1 {expected integer but got "xyz"}}}}
  2057.     {<Key> %#        {-serial 100} 100}
  2058.  
  2059.     {<Key> %s        {-state xyz} {{1 {expected integer but got "xyz"}}}}
  2060.     {<Key> %s        {-state 1} 1}
  2061.     {<Button> %s    {-state 1} 1}
  2062.     {<Motion> %s    {-state 1} 1}
  2063.     {<<Paste>> %s   {-state 1} 1}
  2064.     {<Enter> %s        {-state 1} 1}
  2065.     {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, VisibilityFullyObscured}}}}
  2066.     {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
  2067.     {<Configure> %s {-state xyz} {{1 {bad option to <Configure> event: "-state"}}}}
  2068.  
  2069.     {<Key> %S        {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
  2070.     {<Key> %S        {-subwindow .b} {[winfo id .b]}}
  2071.     {<Key> %S        {-subwindow xyz} {{1 {expected integer but got "xyz"}}}}
  2072.     {<Key> %S        {-subwindow [winfo id .b]} {[winfo id .b]}}
  2073.     {<Button> %S    {-subwindow .b} {[winfo id .b]}}
  2074.     {<Motion> %S    {-subwindow .b} {[winfo id .b]}}
  2075.     {<<Paste>> %S   {-subwindow .b} {[winfo id .b]}}
  2076.     {<Enter> %S        {-subwindow .b} {[winfo id .b]}}
  2077.     {<Configure> %S {-subwindow .b} {{1 {bad option to <Configure> event: "-subwindow"}}}}
  2078.  
  2079.     {<Key> %t        {-time xyz} {{1 {expected integer but got "xyz"}}}}
  2080.     {<Key> %t        {-time 100} 100}
  2081.     {<Button> %t    {-time 100} 100}
  2082.     {<Motion> %t    {-time 100} 100}
  2083.     {<<Paste>> %t   {-time 100} 100}
  2084.     {<Enter> %t        {-time 100} 100}
  2085.     {<Property> %t  {-time 100} 100}
  2086.     {<Configure> %t {-time 100} {{1 {bad option to <Configure> event: "-time"}}}}
  2087.  
  2088.     {<Expose> %w    {-width xyz} {{1 {bad screen distance "xyz"}}}}
  2089.     {<Expose> %w    {-width 2i} {[winfo pixels .b.f 2i]}}
  2090.     {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}}
  2091.     {<Key> %k        {-width 2i} {{1 {bad option to <Key> event: "-width"}}}}
  2092.  
  2093.     {<Unmap> %W    {-window .xyz} {{1 {bad window path name ".xyz"}}}}
  2094.     {<Unmap> %W    {-window .b.f} .b.f}
  2095.     {<Unmap> %W    {-window xyz} {{1 {expected integer but got "xyz"}}}}
  2096.     {<Unmap> %W    {-window [winfo id .b.f]} .b.f}
  2097.     {<Unmap> %W        {-window .b.f} .b.f}
  2098.     {<Map> %W        {-window .b.f} .b.f}
  2099.     {<Reparent> %W  {-window .b.f} .b.f}
  2100.     {<Configure> %W {-window .b.f} .b.f}
  2101.     {<Gravity> %W   {-window .b.f} .b.f}
  2102.     {<Circulate> %W {-window .b.f} .b.f}
  2103.     {<Key> %W        {-window .b.f} {{1 {bad option to <Key> event: "-window"}}}}
  2104.  
  2105.     {<Key> %x        {-x xyz} {{1 {bad screen distance "xyz"}}}}
  2106.     {<Key> %x        {-x 2i} {[winfo pixels .b.f 2i]}}
  2107.     {<Button> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
  2108.     {<Motion> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
  2109.     {<<Paste>> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
  2110.     {<Enter> %x        {-x 2i} {[winfo pixels .b.f 2i]}}
  2111.     {<Expose> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
  2112.     {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
  2113.     {<Gravity> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
  2114.     {<Reparent> %x  {-x 2i} {[winfo pixels .b.f 2i]}}
  2115.     {<Map> %x        {-x 2i} {{1 {bad option to <Map> event: "-x"}}}}
  2116.  
  2117.     {<Key> %y        {-y xyz} {{1 {bad screen distance "xyz"}}}}
  2118.     {<Key> %y        {-y 2i} {[winfo pixels .b.f 2i]}}
  2119.     {<Button> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
  2120.     {<Motion> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
  2121.     {<<Paste>> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
  2122.     {<Enter> %y        {-y 2i} {[winfo pixels .b.f 2i]}}
  2123.     {<Expose> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
  2124.     {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
  2125.     {<Gravity> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
  2126.     {<Reparent> %y  {-y 2i} {[winfo pixels .b.f 2i]}}
  2127.     {<Map> %y        {-y 2i} {{1 {bad option to <Map> event: "-y"}}}}
  2128.  
  2129.     {<Key> %k        {-xyz 1} {{1 {bad option to <Key> event: "-xyz"}}}}
  2130. } {
  2131.     set event [lindex $check 0]
  2132.     test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" {
  2133.     setup
  2134.     bind .b.f $event "lappend x [lindex $check 1]"
  2135.     set x {}
  2136.     if [catch {eval event gen .b.f $event [lindex $check 2]} msg] {
  2137.         set x [list 1 $msg]
  2138.     }
  2139.     set x
  2140.     } [eval set x [lindex $check 3]]
  2141.     incr i
  2142. }
  2143. test bind-23.1 {GetVirtualEventUid procedure} {
  2144.     list [catch {event info <<asd} msg] $msg
  2145. } {1 {virtual event "<<asd" is badly formed}}
  2146. test bind-23.2 {GetVirtualEventUid procedure} {
  2147.     list [catch {event info <<>>} msg] $msg
  2148. } {1 {virtual event "<<>>" is badly formed}}
  2149. test bind-23.3 {GetVirtualEventUid procedure} {
  2150.     list [catch {event info <<asd>} msg] $msg
  2151. } {1 {virtual event "<<asd>" is badly formed}}
  2152. test bind-23.4 {GetVirtualEventUid procedure} {
  2153.     event info <<asd>>
  2154. } {}
  2155.  
  2156.  
  2157. test bind-24.1 {FindSequence procedure: no event} {
  2158.     list [catch {bind .b {} test} msg] $msg
  2159. } {1 {no events specified in binding}}
  2160. test bind-24.2 {FindSequence procedure: bad event} {
  2161.     list [catch {bind .b <xyz> test} msg] $msg
  2162. } {1 {bad event type or keysym "xyz"}}
  2163. test bind-24.3 {FindSequence procedure: virtual allowed} {
  2164.     bind .b.f <<Paste>> test
  2165. } {}
  2166. test bind-24.4 {FindSequence procedure: virtual not allowed} {
  2167.    list [catch {event add <<Paste>> <<Alive>>} msg] $msg
  2168. } {1 {virtual event not allowed in definition of another virtual event}}
  2169. test bind-24.5 {FindSequence procedure, multiple bindings} {
  2170.     setup
  2171.     bind .b.f <1> {lappend x single}
  2172.     bind .b.f <Double-1> {lappend x double}
  2173.     bind .b.f <Triple-1> {lappend x triple}
  2174.     set x press
  2175.     event gen .b.f <Button-1>
  2176.     lappend x press
  2177.     event gen .b.f <Button-1>
  2178.     lappend x press
  2179.     event gen .b.f <Button-1>
  2180.     lappend x press
  2181.     event gen .b.f <Button-1>
  2182.     set x
  2183. } {press single press double press triple press triple}
  2184. test bind-24.6 {FindSequence procedure: virtual composed} {
  2185.     list [catch {bind .b <Control-b><<Paste>> "puts hi"} msg] $msg
  2186. } {1 {virtual events may not be composed}}
  2187. test bind-24.7 {FindSequence procedure: new pattern sequence} {
  2188.     setup
  2189.     bind .b.f <Button-1><Button-2> {lappend x 1-2}
  2190.     set x {}
  2191.     event gen .b.f <Button-1>
  2192.     event gen .b.f <Button-2>
  2193.     set x
  2194. } {1-2}
  2195. test bind-24.8 {FindSequence procedure: similar pattern sequence} {
  2196.     setup
  2197.     bind .b.f <Button-1><Button-2> {lappend x 1-2}
  2198.     bind .b.f <Button-2> {lappend x 2}
  2199.     set x {}
  2200.     event gen .b.f <Button-3>
  2201.     event gen .b.f <Button-2>
  2202.     event gen .b.f <Button-1>
  2203.     event gen .b.f <Button-2>
  2204.     set x
  2205. } {2 1-2}
  2206. test bind-24.9 {FindSequence procedure: similar pattern sequence} {
  2207.     setup
  2208.     bind .b.f <Button-1><Button-2> {lappend x 1-2}
  2209.     bind .b.f <Button-2><Button-2> {lappend x 2-2}
  2210.     set x {}
  2211.     event gen .b.f <Button-3>
  2212.     event gen .b.f <Button-2>
  2213.     event gen .b.f <Button-2>
  2214.     event gen .b.f <Button-1>
  2215.     event gen .b.f <Button-2>
  2216.     set x
  2217. } {2-2 1-2}
  2218. test bind-24.10 {FindSequence procedure: similar pattern sequence} {
  2219.     setup
  2220.     bind .b.f <Button-2><Button-2> {lappend x 2-2}
  2221.     bind .b.f <Double-Button-2> {lappend x d-2}
  2222.     set x {}
  2223.     event gen .b.f <Button-3>
  2224.     event gen .b.f <Button-2>
  2225.     event gen .b.f <Button-2>
  2226.     event gen .b.f <Button-1>
  2227.     event gen .b.f <Button-2> -x 100
  2228.     event gen .b.f <Button-2> -x 200
  2229.     set x
  2230. } {d-2 2-2}
  2231. test bind-24.11 {FindSequence procedure: new sequence, don't create} {
  2232.     setup
  2233.     bind .b.f <Button-2>
  2234. } {}
  2235. test bind-24.12 {FindSequence procedure: not new sequence, don't create} {
  2236.     setup
  2237.     bind .b.f <Control-Button-2> "foo"
  2238.     bind .b.f <Button-2>
  2239. } {}
  2240.  
  2241.  
  2242. test bind-25.1 {ParseEventDescription procedure} {
  2243.     list [catch {bind .b \x7 test} msg] $msg
  2244. } {1 {bad ASCII character 0x7}}
  2245. test bind-25.2 {ParseEventDescription procedure} {
  2246.     list [catch {bind .b "\x7f" test} msg] $msg
  2247. } {1 {bad ASCII character 0x7f}}
  2248. test bind-25.3 {ParseEventDescription procedure} {
  2249.     list [catch {bind .b "\x4" test} msg] $msg
  2250. } {1 {bad ASCII character 0x4}}
  2251. test bind-25.4 {ParseEventDescription procedure} {
  2252.     setup
  2253.     bind .b.f a test
  2254.     bind .b.f a
  2255. } {test}
  2256. test bind-25.5 {ParseEventDescription procedure: virtual} {
  2257.     list [catch {bind .b <<>> foo} msg] $msg
  2258. } {1 {virtual event "<<>>" is badly formed}}
  2259. test bind-25.6 {ParseEventDescription procedure: virtual} {
  2260.     list [catch {bind .b <<Paste foo} msg] $msg
  2261. } {1 {missing ">" in virtual binding}}
  2262. test bind-25.7 {ParseEventDescription procedure: virtual} {
  2263.     list [catch {bind .b <<Paste> foo} msg] $msg
  2264. } {1 {missing ">" in virtual binding}}
  2265. test bind-25.8 {ParseEventDescription procedure: correctly terminate virtual} {
  2266.     list [catch {bind .b <<Paste>>h foo} msg] $msg
  2267. } {1 {virtual events may not be composed}}
  2268. test bind-25.9 {ParseEventDescription procedure} {
  2269.     list [catch {bind .b <> test} msg] $msg
  2270. } {1 {no event type or button # or keysym}}
  2271. test bind-25.10 {ParseEventDescription procedure: misinterpreted modifier} {
  2272.     button .x
  2273.     bind .x <Control-M> a
  2274.     bind .x <M-M> b
  2275.     set x [lsort [bind .x]]
  2276.     destroy .x
  2277.     set x
  2278. } {<Control-Key-M> <Meta-Key-M>}
  2279. test bind-25.11 {ParseEventDescription procedure} {
  2280.     catch {destroy .b.f}
  2281.     frame .b.f -class Test -width 150 -height 100
  2282.     bind .b.f <a---> {nothing}
  2283.     bind .b.f
  2284. } a
  2285. test bind-25.12 {ParseEventDescription procedure} {
  2286.     list [catch {bind .b <a-- test} msg] $msg
  2287. } {1 {missing ">" in binding}}
  2288. test bind-25.13 {ParseEventDescription procedure} {
  2289.     list [catch {bind .b <a-b> test} msg] $msg
  2290. } {1 {extra characters after detail in binding}}
  2291. test bind-25.14 {ParseEventDescription} {
  2292.     setup
  2293.     list [catch {bind .b <<abc {puts hi}} msg] $msg
  2294. } {1 {missing ">" in virtual binding}}
  2295. test bind-25.15 {ParseEventDescription} {
  2296.     setup
  2297.     list [catch {bind .b <<abc> {puts hi}} msg] $msg
  2298. } {1 {missing ">" in virtual binding}}
  2299. test bind-25.16 {ParseEventDescription} {
  2300.     setup
  2301.     bind .b <<Shift-Paste>> {puts hi}
  2302.     bind .b
  2303. } {<<Shift-Paste>>}
  2304. test bind-25.17 {ParseEventDescription} {
  2305.     setup
  2306.     list [catch {event add <<xyz>> <<abc>>} msg] $msg
  2307. } {1 {virtual event not allowed in definition of another virtual event}}
  2308. set i 1
  2309. foreach check {
  2310.     {{<Control- a>} <Control-Key-a>}
  2311.     {<Shift-a> <Shift-Key-a>}
  2312.     {<Lock-a> <Lock-Key-a>}
  2313.     {<Meta---a> <Meta-Key-a>}
  2314.     {<M-a> <Meta-Key-a>}
  2315.     {<Alt-a> <Alt-Key-a>}
  2316.     {<B1-a> <B1-Key-a>}
  2317.     {<B2-a> <B2-Key-a>}
  2318.     {<B3-a> <B3-Key-a>}
  2319.     {<B4-a> <B4-Key-a>}
  2320.     {<B5-a> <B5-Key-a>}
  2321.     {<Button1-a> <B1-Key-a>}
  2322.     {<Button2-a> <B2-Key-a>}
  2323.     {<Button3-a> <B3-Key-a>}
  2324.     {<Button4-a> <B4-Key-a>}
  2325.     {<Button5-a> <B5-Key-a>}
  2326.     {<M1-a> <Mod1-Key-a>}
  2327.     {<M2-a> <Mod2-Key-a>}
  2328.     {<M3-a> <Mod3-Key-a>}
  2329.     {<M4-a> <Mod4-Key-a>}
  2330.     {<M5-a> <Mod5-Key-a>}
  2331.     {<Mod1-a> <Mod1-Key-a>}
  2332.     {<Mod2-a> <Mod2-Key-a>}
  2333.     {<Mod3-a> <Mod3-Key-a>}
  2334.     {<Mod4-a> <Mod4-Key-a>}
  2335.     {<Mod5-a> <Mod5-Key-a>}
  2336.     {<Double-a> <Double-Key-a>}
  2337.     {<Triple-a> <Triple-Key-a>}
  2338.     {{<Double 1>} <Double-Button-1>}
  2339.     {<Triple-1> <Triple-Button-1>}
  2340.     {{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>}
  2341. } {
  2342.     test bind-25.$i {modifier names} {
  2343.     catch {destroy .b.f}
  2344.     frame .b.f -class Test -width 150 -height 100
  2345.     bind .b.f [lindex $check 0] foo
  2346.     bind .b.f
  2347.     } [lindex $check 1]
  2348.     bind .b.f [lindex $check 1] {}
  2349.     incr i
  2350. }
  2351.  
  2352. foreach event [bind Test] {
  2353.     bind Test $event {}
  2354. }
  2355. foreach event [bind all] {
  2356.     bind all $event {}
  2357. }
  2358. test bind-26.1 {event names} {
  2359.     catch {destroy .b.f}
  2360.     frame .b.f -class Test -width 150 -height 100
  2361.     bind .b.f <FocusIn> {nothing}
  2362.     bind .b.f
  2363. } <FocusIn>
  2364. test bind-26.2 {event names} {
  2365.     catch {destroy .b.f}
  2366.     frame .b.f -class Test -width 150 -height 100
  2367.     bind .b.f <FocusOut> {nothing}
  2368.     bind .b.f
  2369. } <FocusOut>
  2370. test bind-26.3 {event names} {
  2371.     setup
  2372.     bind .b.f <Destroy> {lappend x "destroyed"}
  2373.     set x [bind .b.f]
  2374.     destroy .b.f
  2375.     set x
  2376. } {<Destroy> destroyed}
  2377. set i 4
  2378. foreach check { 
  2379.     {Motion Motion}
  2380.     {Button Button}
  2381.     {ButtonPress Button}
  2382.     {ButtonRelease ButtonRelease}
  2383.     {Colormap Colormap}
  2384.     {Enter Enter}
  2385.     {Leave Leave}
  2386.     {Expose Expose}
  2387.     {Key Key}
  2388.     {KeyPress Key}
  2389.     {KeyRelease KeyRelease}
  2390.     {Property Property}
  2391.     {Visibility Visibility}
  2392.     {Activate Activate}
  2393.     {Deactivate Deactivate}
  2394. } {
  2395.     set event [lindex $check 0]
  2396.     test bind-26.$i {event names} {
  2397.     setup
  2398.     bind .b.f <$event> "set x {event $event}"
  2399.     set x xyzzy
  2400.     event gen .b.f <$event>
  2401.     list $x [bind .b.f]
  2402.     } [list "event $event" <[lindex $check 1]>]
  2403.     incr i
  2404. }
  2405. foreach check { 
  2406.     {Circulate Circulate}
  2407.     {Configure Configure}
  2408.     {Gravity Gravity}
  2409.     {Map Map}
  2410.     {Reparent Reparent}
  2411.     {Unmap Unmap}
  2412. } {
  2413.     set event [lindex $check 0]
  2414.     test bind-26.$i {event names} {
  2415.     setup
  2416.     bind .b.f <$event> "set x {event $event}"
  2417.     set x xyzzy
  2418.     event gen .b.f <$event> -window .b.f
  2419.     list $x [bind .b.f]
  2420.     } [list "event $event" <[lindex $check 1]>]
  2421.     incr i
  2422. }
  2423.  
  2424.  
  2425. test bind-27.1 {button names} {
  2426.     list [catch {bind .b <Expose-1> foo} msg] $msg
  2427. } {1 {specified button "1" for non-button event}}
  2428. test bind-27.2 {button names} {
  2429.     list [catch {bind .b <Button-6> foo} msg] $msg
  2430. } {1 {specified keysym "6" for non-key event}}
  2431. set i 3
  2432. foreach button {1 2 3 4 5} {
  2433.     test bind-27.$i {button names} {
  2434.     setup
  2435.     bind .b.f <Button-$button> "lappend x \"button $button\""
  2436.     set x [bind .b.f]
  2437.     event gen .b.f <Button-$button>
  2438.     set x
  2439.     } [list <Button-$button> "button $button"]
  2440.     incr i
  2441. }
  2442.  
  2443. test bind-28.1 {keysym names} {
  2444.     list [catch {bind .b <Expose-a> foo} msg] $msg
  2445. } {1 {specified keysym "a" for non-key event}}
  2446. test bind-28.2 {keysym names} {
  2447.     list [catch {bind .b <Gorp> foo} msg] $msg
  2448. } {1 {bad event type or keysym "Gorp"}}
  2449. test bind-28.3 {keysym names} {
  2450.     list [catch {bind .b <Key-Stupid> foo} msg] $msg
  2451. } {1 {bad event type or keysym "Stupid"}}
  2452. test bind-28.4 {keysym names} {
  2453.     catch {destroy .b.f}
  2454.     frame .b.f -class Test -width 150 -height 100
  2455.     bind .b.f <a> foo
  2456.     bind .b.f
  2457. } a
  2458. set i 5
  2459. foreach check {
  2460.     {a 0 a}
  2461.     {space 0 <Key-space>}
  2462.     {Return 0 <Key-Return>}
  2463.     {X 1 X}
  2464. } {
  2465.     set keysym [lindex $check 0]
  2466.     test bind-28.$i {keysym names} {
  2467.     setup
  2468.     bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\""
  2469.     bind .b.f <Key-x> "lappend x {bad binding match}"
  2470.     set x [lsort [bind .b.f]]
  2471.     event gen .b.f <Key-$keysym> -state [lindex $check 1]
  2472.     set x
  2473.     } [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"]
  2474.     incr i
  2475. }
  2476.  
  2477. test bind-29.1 {dummy test to help ensure proper numbering} {} {}
  2478. setup
  2479. bind .b.f <KeyPress> {set x %K}
  2480. set i 2
  2481. foreach check {
  2482.     {a 0 a}
  2483.     {x 1 X}
  2484.     {x 2 X}
  2485.     {space 0 space}
  2486.     {F1 1 F1}
  2487. } {
  2488.     test bind-29.$i {GetKeySym procedure} {nonPortable} {
  2489.     set x nothing
  2490.     event gen .b.f <KeyPress> -keysym [lindex $check 0] \
  2491.         -state [lindex $check 1]
  2492.     set x
  2493.     } [lindex $check 2]
  2494.     incr i
  2495. }
  2496.  
  2497.  
  2498. proc bgerror msg {
  2499.     global x errorInfo
  2500.     set x [list $msg $errorInfo]
  2501. }
  2502. test bind-30.1 {Tk_BackgroundError procedure} {
  2503.     setup
  2504.     bind .b.f <Button> {error "This is a test"}
  2505.     set x none
  2506.     event gen .b.f <Button>
  2507.     update
  2508.     set x
  2509. } {{This is a test} {This is a test
  2510.     while executing
  2511. "error "This is a test""
  2512.     (command bound to event)}}
  2513. test bind-30.2 {Tk_BackgroundError procedure} {
  2514.     proc do {} {
  2515.     event gen .b.f <Button>
  2516.     }
  2517.     setup
  2518.     bind .b.f <Button> {error Message2}
  2519.     set x none
  2520.     do
  2521.     update
  2522.     set x
  2523. } {Message2 {Message2
  2524.     while executing
  2525. "error Message2"
  2526.     (command bound to event)}}
  2527. rename bgerror {}
  2528.  
  2529.  
  2530. destroy .b
  2531.